Script 'mail_helper' called by obssrc Hello community, here is the log from the commit of package ocaml-sedlex for openSUSE:Factory checked in at 2021-04-29 01:36:50 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ocaml-sedlex (Old) and /work/SRC/openSUSE:Factory/.ocaml-sedlex.new.12324 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ocaml-sedlex" Thu Apr 29 01:36:50 2021 rev:6 rq:867946 version:2.3 Changes: -------- --- /work/SRC/openSUSE:Factory/ocaml-sedlex/ocaml-sedlex.changes 2020-08-24 15:08:43.630558508 +0200 +++ /work/SRC/openSUSE:Factory/.ocaml-sedlex.new.12324/ocaml-sedlex.changes 2021-04-29 01:37:18.942486192 +0200 @@ -1,0 +2,6 @@ +Thu Jan 21 21:21:21 UTC 2021 - [email protected] + +- Update to version 2.3 + Switch to ppxlib + +------------------------------------------------------------------- Old: ---- ocaml-sedlex-2.2.tar.xz New: ---- ocaml-sedlex-2.3.tar.xz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ocaml-sedlex.spec ++++++ --- /var/tmp/diff_new_pack.RASiVu/_old 2021-04-29 01:37:19.310486713 +0200 +++ /var/tmp/diff_new_pack.RASiVu/_new 2021-04-29 01:37:19.314486718 +0200 @@ -1,7 +1,7 @@ # # spec file for package ocaml-sedlex # -# Copyright (c) 2020 SUSE LLC +# Copyright (c) 2021 SUSE LLC # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -17,7 +17,7 @@ Name: ocaml-sedlex -Version: 2.2 +Version: 2.3 Release: 0 %{?ocaml_preserve_bytecode} Summary: Unicode-friendly lexer generator @@ -27,10 +27,9 @@ Source0: %{name}-%{version}.tar.xz BuildRequires: ocaml BuildRequires: ocaml-dune -BuildRequires: ocaml-rpm-macros >= 20200514 +BuildRequires: ocaml-rpm-macros >= 20210121 BuildRequires: ocamlfind(gen) -BuildRequires: ocamlfind(ocaml-migrate-parsetree) -BuildRequires: ocamlfind(ppx_tools_versioned.metaquot_408) +BuildRequires: ocamlfind(ppxlib) BuildRequires: ocamlfind(uchar) %description ++++++ _service ++++++ --- /var/tmp/diff_new_pack.RASiVu/_old 2021-04-29 01:37:19.342486759 +0200 +++ /var/tmp/diff_new_pack.RASiVu/_new 2021-04-29 01:37:19.342486759 +0200 @@ -1,7 +1,7 @@ <services> <service name="tar_scm" mode="disabled"> <param name="filename">ocaml-sedlex</param> - <param name="revision">25c0dbd82c7fc5d91102f5bd21db1411f2c46323</param> + <param name="revision">f39c7e4a6e6d4ad2f443a10be80438a476e10b8b</param> <param name="scm">git</param> <param name="submodules">disable</param> <param name="url">https://github.com/ocaml-community/sedlex.git</param> ++++++ ocaml-sedlex-2.2.tar.xz -> ocaml-sedlex-2.3.tar.xz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-sedlex-2.2/.travis.yml new/ocaml-sedlex-2.3/.travis.yml --- old/ocaml-sedlex-2.2/.travis.yml 2020-02-08 22:55:37.000000000 +0100 +++ new/ocaml-sedlex-2.3/.travis.yml 2021-01-16 20:23:03.000000000 +0100 @@ -6,13 +6,14 @@ global: - PACKAGE=sedlex matrix: - - OCAML_VERSION=4.02 - - OCAML_VERSION=4.03 - OCAML_VERSION=4.04 - OCAML_VERSION=4.05 - OCAML_VERSION=4.06 - OCAML_VERSION=4.07 - OCAML_VERSION=4.08 + - OCAML_VERSION=4.09 + - OCAML_VERSION=4.10 + - OCAML_VERSION=4.11 os: - linux - osx diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-sedlex-2.2/CHANGES new/ocaml-sedlex-2.3/CHANGES --- old/ocaml-sedlex-2.2/CHANGES 2020-02-08 22:55:37.000000000 +0100 +++ new/ocaml-sedlex-2.3/CHANGES 2021-01-16 20:23:03.000000000 +0100 @@ -1,3 +1,6 @@ +2.3 + * Switch to ppxlib + 2.2 * Support for OCaml 4.08 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-sedlex-2.2/README.md new/ocaml-sedlex-2.3/README.md --- old/ocaml-sedlex-2.2/README.md 2020-02-08 22:55:37.000000000 +0100 +++ new/ocaml-sedlex-2.3/README.md 2021-01-16 20:23:03.000000000 +0100 @@ -199,13 +199,13 @@ Compilation of OCaml files with lexer specifications: ``` - ocamlfind ocamlc -c -package sedlex my_file.ml + ocamlfind ocamlc -c -package sedlex.ppx my_file.ml ``` When linking, you must also include the sedlex package: ``` - ocamlfind ocamlc -o my_prog -linkpkg -package sedlex my_file.cmo + ocamlfind ocamlc -o my_prog -linkpkg -package sedlex.ppx my_file.cmo ``` @@ -221,6 +221,14 @@ link the application with the runtime support library for sedlex (sedlexing.cma / sedlexing.cmxa). +### With utop + +Once sedlex is installed as per above, simply type + +``` +#require "sedlex.ppx";; +``` + ## Examples The `examples/` subdirectory contains several samples of sedlex in use. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-sedlex-2.2/sedlex.opam new/ocaml-sedlex-2.3/sedlex.opam --- old/ocaml-sedlex-2.2/sedlex.opam 2020-02-08 22:55:37.000000000 +0100 +++ new/ocaml-sedlex-2.3/sedlex.opam 2021-01-16 20:23:03.000000000 +0100 @@ -7,7 +7,7 @@ OCaml source files. Lexing specific constructs are provided via a ppx syntax extension. " -version: "2.2" +version: "2.3" license: "MIT" doc: "https://ocaml-community.github.io/sedlex/index.html"; maintainer: "Alain Frisch <[email protected]>" @@ -24,10 +24,9 @@ ["dune" "build" "@doc" "-p" name "-j" jobs] {with-doc} ] depends: [ - "ocaml" {>= "4.02.3"} + "ocaml" {>= "4.04"} "dune" {>= "1.8"} - "ppx_tools_versioned" {>= "5.2.3"} - "ocaml-migrate-parsetree" + "ppxlib" {>= "0.18.0"} "gen" "uchar" ] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-sedlex-2.2/src/generator/gen_unicode.ml.inc new/ocaml-sedlex-2.3/src/generator/gen_unicode.ml.inc --- old/ocaml-sedlex-2.2/src/generator/gen_unicode.ml.inc 2020-02-08 22:55:37.000000000 +0100 +++ new/ocaml-sedlex-2.3/src/generator/gen_unicode.ml.inc 2021-01-16 20:23:03.000000000 +0100 @@ -77,14 +77,14 @@ let print_elements ch hashtbl = let cats = - List.sort_uniq Pervasives.compare + List.sort_uniq compare (Hashtbl.fold (fun cat _ l -> cat::l) hashtbl []) in let len = List.length cats in List.iter (fun c -> let entries = List.map (fun (b,e) -> Printf.sprintf "0x%x, 0x%x" b e) - (List.sort_uniq Pervasives.compare + (List.sort_uniq compare (Hashtbl.find_all hashtbl c)) in let entries = diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-sedlex-2.2/src/syntax/dune new/ocaml-sedlex-2.3/src/syntax/dune --- old/ocaml-sedlex-2.2/src/syntax/dune 2020-02-08 22:55:37.000000000 +0100 +++ new/ocaml-sedlex-2.3/src/syntax/dune 2021-01-16 20:23:03.000000000 +0100 @@ -2,17 +2,20 @@ (name sedlex_ppx) (public_name sedlex.ppx) (kind ppx_rewriter) - (libraries ppx_tools_versioned.metaquot_408 ocaml-migrate-parsetree sedlex) + (libraries ppxlib sedlex) (ppx_runtime_libraries sedlex) (preprocess - (pps ppx_tools_versioned.metaquot_408)) - (flags (:standard -w -9))) + (pps ppxlib.metaquot)) + (flags + (:standard -w -9))) (rule (targets unicode.ml) (mode promote-until-clean) - (deps (:gen ../generator/gen_unicode.exe) - ../generator/data/DerivedCoreProperties.txt - ../generator/data/DerivedGeneralCategory.txt - ../generator/data/PropList.txt) - (action (run %{gen} %{targets}))) + (deps + (:gen ../generator/gen_unicode.exe) + ../generator/data/DerivedCoreProperties.txt + ../generator/data/DerivedGeneralCategory.txt + ../generator/data/PropList.txt) + (action + (run %{gen} %{targets}))) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-sedlex-2.2/src/syntax/ppx_sedlex.ml new/ocaml-sedlex-2.3/src/syntax/ppx_sedlex.ml --- old/ocaml-sedlex-2.2/src/syntax/ppx_sedlex.ml 2020-02-08 22:55:37.000000000 +0100 +++ new/ocaml-sedlex-2.3/src/syntax/ppx_sedlex.ml 2021-01-16 20:23:03.000000000 +0100 @@ -2,22 +2,22 @@ (* See the attached LICENSE file. *) (* Copyright 2005, 2013 by Alain Frisch and LexiFi. *) -open Longident -open Migrate_parsetree -open Ast_408 -open Parsetree -open Asttypes -open Ast_helper -open Ast_convenience_408 +open Ppxlib +open Ast_builder.Default -module Ast_mapper_class = Ast_mapper_class_408 - -let ocaml_version = Versions.ocaml_408 +(* let ocaml_version = Versions.ocaml_408 *) module Cset = Sedlex_cset (* Decision tree for partitions *) +let default_loc = Location.none + +let lident_loc ~loc s = { + loc; + txt= lident s +} + type decision_tree = | Lte of int * decision_tree * decision_tree | Table of int * int array @@ -80,8 +80,13 @@ (* Helpers to build AST *) -let appfun s l = app (evar s) l -let glb_value name def = Str.value Nonrecursive [Vb.mk (pvar name) def] +let appfun s l = + let loc = default_loc in + eapply ~loc (evar ~loc s) l + +let glb_value name def = + let loc = default_loc in + pstr_value ~loc Nonrecursive [value_binding ~loc ~pat:(pvar ~loc name) ~expr:def] (* Named regexps *) @@ -125,7 +130,7 @@ let n = Array.length v in let s = Bytes.create n in for i = 0 to n - 1 do Bytes.set s i (Char.chr v.(i)) done; - glb_value name (str (Bytes.to_string s)) + glb_value name (estring ~loc:default_loc (Bytes.to_string s)) (* Partition (function: codepoint -> next state) *) @@ -144,19 +149,26 @@ (* We duplicate the body for the EOF (-1) case rather than creating an interior utility function. *) let partition (name, p) = + let loc = default_loc in let rec gen_tree = function | Lte (i, yes, no) -> - [%expr if c <= [%e int i] then [%e gen_tree yes] else [%e gen_tree no]] - | Return i -> int i + [%expr if c <= [%e eint ~loc i] then [%e gen_tree yes] else [%e gen_tree no]] + | Return i -> eint ~loc:default_loc i | Table (offset, t) -> - let c = if offset = 0 then [%expr c] else [%expr c - [%e int offset]] in - [%expr Char.code (String.get [%e evar (table_name t)] [%e c]) - 1] + let c = if offset = 0 then [%expr c] else [%expr c - [%e eint ~loc offset]] in + [%expr Char.code (String.get [%e evar ~loc (table_name t)] [%e c]) - 1] in let body = gen_tree (decision_table p) in - glb_value name (func [(pconstr "Some" [pvar "uc"], - [%expr let c = Uchar.to_int uc in [%e body]]); - (pconstr "None" [], - [%expr let c = (-1) in [%e body]])]) + glb_value name + (pexp_function ~loc [ + case + ~lhs:(ppat_construct ~loc (lident_loc ~loc "Some") (Some (pvar ~loc "uc"))) + ~guard:None + ~rhs:[%expr let c = Uchar.to_int uc in [%e body]]; + case + ~lhs:(ppat_construct ~loc (lident_loc ~loc "None") None) + ~guard:None + ~rhs:[%expr let c = (-1) in [%e body]]]) (* Code generation for the automata *) @@ -173,24 +185,25 @@ let (trans, final) = auto.(state) in if Array.length trans = 0 then match best_final final with - | Some i -> int i + | Some i -> eint ~loc:default_loc i | None -> assert false - else appfun (state_fun state) [evar lexbuf] + else appfun (state_fun state) [evar ~loc:default_loc lexbuf] let gen_state lexbuf auto i (trans, final) = + let loc = default_loc in let partition = Array.map fst trans in - let cases = Array.mapi (fun i (_, j) -> Exp.case(pint i) (call_state lexbuf auto j)) trans in + let cases = Array.mapi (fun i (_, j) -> case ~lhs:(pint ~loc i) ~guard:None ~rhs:(call_state lexbuf auto j)) trans in let cases = Array.to_list cases in let body () = - Exp.match_ - (appfun (partition_name partition) [[%expr Sedlexing.next [%e evar lexbuf]]]) - (cases @ [Exp.case [%pat? _] [%expr Sedlexing.backtrack [%e evar lexbuf]]]) + pexp_match ~loc + (appfun (partition_name partition) [[%expr Sedlexing.next [%e evar ~loc lexbuf]]]) + (cases @ [case ~lhs:[%pat? _] ~guard:None ~rhs:[%expr Sedlexing.backtrack [%e evar ~loc lexbuf]]]) in - let ret body = [ Vb.mk (pvar (state_fun i)) (func [pvar lexbuf, body]) ] in + let ret body = [ value_binding ~loc ~pat:(pvar ~loc (state_fun i)) ~expr:(pexp_function ~loc [case ~lhs:(pvar ~loc lexbuf) ~guard:None ~rhs:body]) ] in match best_final final with | None -> ret (body ()) | Some _ when Array.length trans = 0 -> [] - | Some i -> ret [%expr Sedlexing.mark [%e evar lexbuf] [%e int i]; [%e body ()]] + | Some i -> ret [%expr Sedlexing.mark [%e evar ~loc lexbuf] [%e eint ~loc i]; [%e body ()]] let gen_recflag auto = (* The generated function is not recursive if the transitions end @@ -209,16 +222,17 @@ Exit -> Recursive let gen_definition lexbuf l error = + let loc = default_loc in let brs = Array.of_list l in let auto = Sedlex.compile (Array.map fst brs) in - let cases = Array.to_list (Array.mapi (fun i (_, e) -> Exp.case (pint i) e) brs) in + let cases = Array.to_list (Array.mapi (fun i (_, e) -> case ~lhs:(pint ~loc i) ~guard:None ~rhs:e) brs) in let states = Array.mapi (gen_state lexbuf auto) auto in let states = List.flatten (Array.to_list states) in - Exp.let_ (gen_recflag auto) states - (Exp.sequence - [%expr Sedlexing.start [%e evar lexbuf]] - (Exp.match_ (appfun (state_fun 0) [evar lexbuf]) - (cases @ [Exp.case (Pat.any ()) error]) + pexp_let ~loc (gen_recflag auto) states + (pexp_sequence ~loc + [%expr Sedlexing.start [%e evar ~loc lexbuf]] + (pexp_match ~loc (appfun (state_fun 0) [evar ~loc lexbuf]) + (cases @ [case ~lhs:(ppat_any ~loc) ~guard:None ~rhs:error]) ) ) @@ -240,7 +254,7 @@ in aux 0 let err loc s = - raise (Location.Error (Location.error ~loc ("Sedlex: " ^ s))) + raise (Location.Error (Location.Error.createf ~loc "Sedlex: %s" s)) let rec repeat r = function | 0, 0 -> Sedlex.eps @@ -272,7 +286,7 @@ | Ppat_construct ({txt = Lident "Rep"}, Some {ppat_desc=Ppat_tuple[p0; {ppat_desc=Ppat_constant (i1 as i2)|Ppat_interval(i1, i2)}]}) -> - begin match Constant.of_constant i1, Constant.of_constant i2 with + begin match i1, i2 with | Pconst_integer(i1,_), Pconst_integer(i2,_) -> let i1 = int_of_string i1 in let i2 = int_of_string i2 in @@ -303,11 +317,11 @@ | Ppat_construct ({txt = Lident "Chars"}, arg) -> let const = match arg with | Some {ppat_desc=Ppat_constant const} -> - Some (Constant.of_constant const) + Some (const) | _ -> None in begin match const with - | Some (Pconst_string(s,_))-> + | Some (Pconst_string(s,_, _))-> let c = ref Cset.empty in for i = 0 to String.length s - 1 do c := Cset.union !c (Cset.singleton (Char.code s.[i])) @@ -316,15 +330,15 @@ | _ -> err p.ppat_loc "the Chars operator requires a string argument" end | Ppat_interval (i_start, i_end) -> - begin match Constant.of_constant i_start, Constant.of_constant i_end with + begin match i_start, i_end with | Pconst_char c1, Pconst_char c2 -> Sedlex.chars (Cset.interval (Char.code c1) (Char.code c2)) | Pconst_integer(i1,_), Pconst_integer(i2,_) -> Sedlex.chars (Cset.interval (codepoint (int_of_string i1)) (codepoint (int_of_string i2))) | _ -> err p.ppat_loc "this pattern is not a valid interval regexp" end | Ppat_constant (const) -> - begin match Constant.of_constant const with - | Pconst_string (s, _) -> regexp_for_string s + begin match const with + | Pconst_string (s, _, _) -> regexp_for_string s | Pconst_char c -> regexp_for_char c | Pconst_integer(i,_) -> Sedlex.chars (Cset.singleton (codepoint (int_of_string i))) | _ -> err p.ppat_loc "this pattern is not a valid regexp" @@ -340,16 +354,20 @@ aux -let mapper cookies = +let previous = ref [] +let regexps = ref [] +let should_set_cookies = ref false + +let mapper = object(this) - inherit Ast_mapper_class.mapper as super + inherit Ast_traverse.map as super val env = builtin_regexps method define_regexp name p = {< env = StringMap.add name (regexp_of_pattern env p) env >} - method! expr e = + method! expression e = match e with | [%expr [%sedlex [%e? {pexp_desc=Pexp_match (lexbuf, cases)}]]] -> let lexbuf = @@ -361,7 +379,7 @@ let cases = List.rev cases in let error = match List.hd cases with - | {pc_lhs = [%pat? _]; pc_rhs = e; pc_guard = None} -> super # expr e + | {pc_lhs = [%pat? _]; pc_rhs = e; pc_guard = None} -> super # expression e | {pc_lhs = p} -> err p.ppat_loc "the last branch must be a catch-all error case" in @@ -369,17 +387,17 @@ let cases = List.map (function - | {pc_lhs = p; pc_rhs = e; pc_guard = None} -> regexp_of_pattern env p, super # expr e + | {pc_lhs = p; pc_rhs = e; pc_guard = None} -> regexp_of_pattern env p, super # expression e | {pc_guard = Some e} -> err e.pexp_loc "'when' guards are not supported" ) cases in gen_definition lexbuf cases error | [%expr let [%p? {ppat_desc=Ppat_var{txt=name}}] = [%sedlex.regexp? [%p? p]] in [%e? body]] -> - (this # define_regexp name p) # expr body + (this # define_regexp name p) # expression body | [%expr [%sedlex [%e? _]]] -> err e.pexp_loc "the %sedlex extension is only recognized on match expressions" - | _ -> super # expr e + | _ -> super # expression e val toplevel = true @@ -402,24 +420,39 @@ method! structure l = if toplevel then let sub = {< toplevel = false >} in - let previous = - match Driver.get_cookie cookies "sedlex.regexps" ocaml_version with - | Some {pexp_desc = Pexp_extension (_, PStr l)} -> l - | Some _ -> assert false - | None -> [] - in - let l, regexps = sub # structure_with_regexps (previous @ l) in + let l, regexps' = sub # structure_with_regexps (!previous @ l) in let parts = List.map partition (get_partitions ()) in let tables = List.map table (get_tables ()) in - Driver.set_cookie cookies "sedlex.regexps" ocaml_version (Exp.extension (Location.mknoloc "regexps", PStr regexps)); + regexps := regexps'; + should_set_cookies := true; tables @ parts @ l else fst (this # structure_with_regexps l) end +let pre_handler cookies = + previous := + match Driver.Cookies.get cookies "sedlex.regexps" Ast_pattern.__ with + | Some {pexp_desc = Pexp_extension (_, PStr l)} -> l + | Some _ -> assert false + | None -> [] + +let post_handler cookies = + if !should_set_cookies then + let loc = default_loc in + Driver.Cookies.set cookies "sedlex.regexps" (pexp_extension ~loc ( {loc; txt="regexps"}, PStr !regexps)) + + +let extensions = + [Extension.declare + "sedlex" + Extension.Context.expression + Ast_pattern.(single_expr_payload __) + (fun ~loc:_ ~path:_ expr -> mapper # expression expr); + ] + let () = - Driver.register - ~name:"sedlex" - ocaml_version - (fun _ cookies -> Ast_mapper_class.to_mapper (mapper cookies)) + Driver.Cookies.add_handler pre_handler; + Driver.Cookies.add_post_handler post_handler; + Driver.register_transformation "sedlex" ~impl:(mapper # structure)
