diff --git a/.github/opam/liquidsoap-core-windows.opam b/.github/opam/liquidsoap-core-windows.opam index 45c2d5b947..4cb40dcc67 100644 --- a/.github/opam/liquidsoap-core-windows.opam +++ b/.github/opam/liquidsoap-core-windows.opam @@ -22,7 +22,7 @@ depends: [ "dtools-windows" {>= "0.4.5"} "duppy-windows" {>= "0.9.3"} "mm-windows" {>= "0.8.4"} - "pcre-windows" {>= "7.5.0"} + "re-windows" {>= "1.11.0"} "cry-windows" {>= "1.0.1"} "sedlex" {>= "3.2"} "sedlex-windows" {>= "3.2"} diff --git a/.github/scripts/build-posix.sh b/.github/scripts/build-posix.sh index 3a4085df7d..48fa78d115 100755 --- a/.github/scripts/build-posix.sh +++ b/.github/scripts/build-posix.sh @@ -37,6 +37,9 @@ sed -e 's@ocaml-gstreamer@#ocaml-gstreamer@' -i PACKAGES export PKG_CONFIG_PATH=/usr/share/pkgconfig/pkgconfig +opam update +opam install -y re.1.11.0 + echo "::endgroup::" echo "::group::Checking out CI commit" diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index bdc46a81e9..4565f3c77b 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -118,6 +118,8 @@ jobs: run: | cd /tmp/liquidsoap-full/liquidsoap eval "$(opam config env)" + opam update + opam install -y re.1.11.0 dune build --profile release ./src/js/interactive_js.bc.js tree_sitter_parse: diff --git a/dune-project b/dune-project index 9a32a4918c..5b76ad4e93 100644 --- a/dune-project +++ b/dune-project @@ -48,7 +48,7 @@ (dtools (>= 0.4.5)) (duppy (>= 0.9.3)) (mm (>= 0.8.4)) - (pcre (>= 7.5.0)) + (re (>= 1.11.0)) (ocurl (>= 0.9.2)) (cry (>= 1.0.0)) (camomile (>= 2.0.0)) @@ -151,6 +151,7 @@ (depends (ocaml (>= 4.14.0)) dune-site + (re (>= 1.11.0)) (ppx_string :build) (sedlex (>= 3.2)) (menhir (>= 20180703))) diff --git a/liquidsoap-core.opam b/liquidsoap-core.opam index 7fe8ee0162..bff54d1f48 100644 --- a/liquidsoap-core.opam +++ b/liquidsoap-core.opam @@ -13,7 +13,7 @@ depends: [ "dtools" {>= "0.4.5"} "duppy" {>= "0.9.3"} "mm" {>= "0.8.4"} - "pcre" {>= "7.5.0"} + "re" {>= "1.11.0"} "ocurl" {>= "0.9.2"} "cry" {>= "1.0.0"} "camomile" {>= "2.0.0"} diff --git a/liquidsoap-lang.opam b/liquidsoap-lang.opam index e9f94e4b96..99f502dc11 100644 --- a/liquidsoap-lang.opam +++ b/liquidsoap-lang.opam @@ -11,6 +11,7 @@ depends: [ "dune" {>= "3.6"} "ocaml" {>= "4.14.0"} "dune-site" + "re" {>= "1.11.0"} "ppx_string" {build} "sedlex" {>= "3.2"} "menhir" {>= "20180703"} diff --git a/src/core/builtins/builtins_files.ml b/src/core/builtins/builtins_files.ml index a143ffb9c0..27737bdde0 100644 --- a/src/core/builtins/builtins_files.ml +++ b/src/core/builtins/builtins_files.ml @@ -1,3 +1,5 @@ +module Pcre = Re.Pcre + module Filename = struct include Filename diff --git a/src/core/builtins/builtins_server.ml b/src/core/builtins/builtins_server.ml index a8ef2ba709..bce8ab32c0 100644 --- a/src/core/builtins/builtins_server.ml +++ b/src/core/builtins/builtins_server.ml @@ -20,6 +20,8 @@ *****************************************************************************) +module Pcre = Re.Pcre + let _ = Lang.add_builtin ~base:Modules.server "register" ~category:`Interaction ~descr: @@ -64,6 +66,6 @@ let _ = in let f = Lang.assoc "" 2 p in let f x = Lang.to_string (Lang.apply f [("", Lang.string x)]) in - let ns = Pcre.split ~pat:"\\." namespace in + let ns = Pcre.split ~rex:(Pcre.regexp "\\.") namespace in Server.add ~ns ~usage ~descr command f; Lang.unit) diff --git a/src/core/builtins/builtins_sys.ml b/src/core/builtins/builtins_sys.ml index c12b6d5a8c..8f7b495f11 100644 --- a/src/core/builtins/builtins_sys.ml +++ b/src/core/builtins/builtins_sys.ml @@ -21,6 +21,7 @@ *****************************************************************************) open Extralib +module Pcre = Re.Pcre let configure = Modules.configure @@ -224,7 +225,7 @@ let _ = let a = Lang.to_string (Lang.assoc "" 2 p) in let s = match a with "" -> c | _ -> c ^ " " ^ a in let r = try Server.exec s with Not_found -> "Command not found!" in - Lang.list (List.map Lang.string (Pcre.split ~pat:"\r?\n" r)) + Lang.list (List.map Lang.string (Pcre.split ~rex:(Pcre.regexp "\r?\n") r)) in Lang.add_builtin ~base:Modules.server "execute" ~category ~descr params return_t execute diff --git a/src/core/dune b/src/core/dune index 3edab0eba3..139eb50247 100644 --- a/src/core/dune +++ b/src/core/dune @@ -29,6 +29,7 @@ camomile.lib curl cry + re uri metadata (select diff --git a/src/core/encoder/formats/ffmpeg_format.ml b/src/core/encoder/formats/ffmpeg_format.ml index 97268a7977..f6102706b3 100644 --- a/src/core/encoder/formats/ffmpeg_format.ml +++ b/src/core/encoder/formats/ffmpeg_format.ml @@ -20,6 +20,8 @@ *****************************************************************************) +module Pcre = Re.Pcre + type opt_val = [ `String of string | `Int of int | `Int64 of int64 | `Float of float ] @@ -135,7 +137,8 @@ let to_string m = | None -> `Var "none" | Some d -> `String d); Printf.sprintf "%%%s(%s%s)" name - (if Pcre.pmatch ~pat:"video" name then "" else "video_content,") + (if Pcre.pmatch ~rex:(Pcre.regexp "video") name then "" + else "video_content,") (string_of_options stream_opts) :: opts | `Encode { codec; options = `Audio options; opts = stream_opts } -> @@ -149,7 +152,8 @@ let to_string m = Hashtbl.add stream_opts "samplerate" (`Int (Lazy.force options.samplerate)); Printf.sprintf "%s(%s%s)" name - (if Pcre.pmatch ~pat:"audio" name then "" else "audio_content,") + (if Pcre.pmatch ~rex:(Pcre.regexp "audio") name then "" + else "audio_content,") (string_of_options stream_opts) :: opts) opts m.streams diff --git a/src/core/harbor/harbor.ml b/src/core/harbor/harbor.ml index d322625554..5495f2d5cf 100644 --- a/src/core/harbor/harbor.ml +++ b/src/core/harbor/harbor.ml @@ -21,9 +21,9 @@ *****************************************************************************) open Harbor_base +module Pcre = Re.Pcre module Monad = Duppy.Monad module Type = Liquidsoap_lang.Type -module Regexp = Liquidsoap_lang.Regexp module Http_base = Http let ( let* ) = Duppy.Monad.bind @@ -362,7 +362,7 @@ module Make (T : Transport_t) : T with type socket = T.socket = struct let websocket_error n msg = Websocket.to_string (`Close (Some (n, msg))) let parse_icy_request_line ~port h r = - let auth_data = Pcre.split ~pat:":" r in + let auth_data = Pcre.split ~rex:(Pcre.regexp ":") r in let requested_user, password = match auth_data with | user :: password :: _ -> (user, password) @@ -453,7 +453,9 @@ module Make (T : Transport_t) : T with type socket = T.socket = struct let data = Pcre.split ~rex:(Pcre.regexp "[ \t]+") auth in match data with | "Basic" :: x :: _ -> ( - let auth_data = Pcre.split ~pat:":" (Lang_string.decode64 x) in + let auth_data = + Pcre.split ~rex:(Pcre.regexp ":") (Lang_string.decode64 x) + in match auth_data with | x :: y :: _ -> (x, y) | _ -> raise Not_found) @@ -788,11 +790,22 @@ module Make (T : Transport_t) : T with type socket = T.socket = struct (* First, try with a registered handler. *) let { handler; _ } = find_handler port in - let f (verb, rex, handler) = - if (verb :> verb) = hmethod && Lang.Regexp.test rex base_uri then ( - let { Lang.Regexp.groups } = Lang.Regexp.exec rex base_uri in + let f (verb, regex, handler) = + let rex = regex.Liquidsoap_lang.Builtins_regexp.regexp in + let sub = lazy (try Some (Re.Pcre.exec ~rex base_uri) with _ -> None) in + if (verb :> verb) = hmethod && Lazy.force sub <> None then ( + let sub = Option.get (Lazy.force sub) in + let groups = + List.fold_left + (fun groups name -> + try (name, Re.Pcre.get_named_substring rex name sub) :: groups + with Not_found -> groups) + [] + (Array.to_list (Re.Pcre.names rex)) + in log#info "Found handler '%s %s' on port %d%s." smethod - (Lang.descr_of_regexp rex) port + (Lang.descr_of_regexp regex) + port (match groups with | [] -> "" | groups -> diff --git a/src/core/hooks_implementations.ml b/src/core/hooks_implementations.ml index 941d3f3afa..36c3c79df6 100644 --- a/src/core/hooks_implementations.ml +++ b/src/core/hooks_implementations.ml @@ -1,45 +1,6 @@ module Hooks = Liquidsoap_lang.Hooks module Lang = Liquidsoap_lang.Lang -let cflags_of_flags (flags : Liquidsoap_lang.Regexp.flag list) = - List.fold_left - (fun l f -> - match f with - | `i -> `CASELESS :: l - (* `g is handled at the call level. *) - | `g -> l - | `s -> `DOTALL :: l - | `m -> `MULTILINE :: l) - [] flags - -let regexp ?(flags = []) s = - let iflags = Pcre.cflags (cflags_of_flags flags) in - let rex = Pcre.regexp ~iflags s in - object - method split s = Pcre.split ~rex s - - method exec s = - let sub = Pcre.exec ~rex s in - let matches = Array.to_list (Pcre.get_opt_substrings sub) in - let groups = - List.fold_left - (fun groups name -> - try (name, Pcre.get_named_substring rex name sub) :: groups - with _ -> groups) - [] - (Array.to_list (Pcre.names rex)) - in - { Lang.Regexp.matches; groups } - - method test s = Pcre.pmatch ~rex s - - method substitute ~subst s = - let substitute = - if List.mem `g flags then Pcre.substitute else Pcre.substitute_first - in - substitute ~rex ~subst s - end - (* For source eval check there are cases of: source('a) <: (source('a).{ source methods })? b/c of source.dynamic so we want to dig deeper @@ -153,7 +114,6 @@ let register () = Dtools.Log.conf_file#on_change on_change; ignore (Option.map on_change Dtools.Log.conf_file#get_d); Hooks.collect_after := Clock.collect_after; - Hooks.regexp := regexp; (Hooks.make_log := fun name -> (Log.make name :> Hooks.log)); Hooks.type_of_encoder := Lang_encoder.type_of_encoder; Hooks.make_encoder := Lang_encoder.make_encoder; diff --git a/src/core/lang.mli b/src/core/lang.mli index dfbe7f9d86..c021295fbd 100644 --- a/src/core/lang.mli +++ b/src/core/lang.mli @@ -29,7 +29,7 @@ type t = Liquidsoap_lang.Type.t type module_name = Liquidsoap_lang.Lang.module_name type scheme = Liquidsoap_lang.Type.scheme -type regexp +type regexp = Liquidsoap_lang.Lang.regexp (** {2 Values} *) @@ -333,12 +333,3 @@ val descr_of_regexp : regexp -> string (** Return a string description of a regexp value i.e. r/^foo\/bla$/g *) val string_of_regexp : regexp -> string - -module Regexp : sig - include Liquidsoap_lang.Regexp.T with type t := regexp - - type sub = Liquidsoap_lang.Regexp.sub = { - matches : string option list; - groups : (string * string) list; - } -end diff --git a/src/core/operators/chord.ml b/src/core/operators/chord.ml index 96484886e5..47d15950cd 100644 --- a/src/core/operators/chord.ml +++ b/src/core/operators/chord.ml @@ -22,6 +22,7 @@ open Mm open Source +module Pcre = Re.Pcre let chan = 0 @@ -71,7 +72,9 @@ class chord metadata_name (source : source) = | Some c -> ( try let sub = - Pcre.exec ~pat:"^([A-G-](?:b|#)?)(|M|m|M7|m7|dim)$" c + Pcre.exec + ~rex:(Pcre.regexp "^([A-G-](?:b|#)?)(|M|m|M7|m7|dim)$") + c in let n = Pcre.get_substring sub 1 in let n = note_of_string n in diff --git a/src/core/outputs/harbor_output.ml b/src/core/outputs/harbor_output.ml index de8dc6800d..de166e975b 100644 --- a/src/core/outputs/harbor_output.ml +++ b/src/core/outputs/harbor_output.ml @@ -349,7 +349,11 @@ class output p = let uri = match mount.[0] with '/' -> mount | _ -> Printf.sprintf "%c%s" '/' mount in - let uri = Lang.Regexp.regexp [%string {|^%{uri}$|}] in + let uri = + let regexp = [%string {|^%{uri}$|}] in + Liquidsoap_lang.Builtins_regexp. + { descr = regexp; flags = []; regexp = Re.Pcre.regexp regexp } + in let autostart = Lang.to_bool (List.assoc "start" p) in let infallible = not (Lang.to_bool (List.assoc "fallible" p)) in let on_start = diff --git a/src/core/outputs/pipe_output.ml b/src/core/outputs/pipe_output.ml index f0669ab3db..99d63f69f9 100644 --- a/src/core/outputs/pipe_output.ml +++ b/src/core/outputs/pipe_output.ml @@ -22,6 +22,8 @@ (** base class *) +module Pcre = Re.Pcre + let output = Modules.output let encoder_factory ?format format_val = @@ -436,7 +438,9 @@ class virtual ['a] file_output_base p = let filename = filename () in let filename = Lang_string.home_unrelate filename in (* Avoid / in metas for filename.. *) - let subst m = Pcre.substitute ~pat:"/" ~subst:(fun _ -> "-") m in + let subst m = + Pcre.substitute ~rex:(Pcre.regexp "/") ~subst:(fun _ -> "-") m + in self#interpolate ~subst filename method virtual open_out_gen : open_flag list -> int -> string -> 'a diff --git a/src/core/playlists/playlist_basic.ml b/src/core/playlists/playlist_basic.ml index d70cd28dd3..48b9832c68 100644 --- a/src/core/playlists/playlist_basic.ml +++ b/src/core/playlists/playlist_basic.ml @@ -20,8 +20,10 @@ *****************************************************************************) +module Pcre = Re.Pcre + let log = Log.make ["playlist"; "basic"] -let split_lines buf = Pcre.split ~pat:"[\r\n]+" buf +let split_lines buf = Pcre.split ~rex:(Pcre.regexp "[\r\n]+") buf let parse_meta = let processor = @@ -61,7 +63,7 @@ let parse_extinf s = | "" -> meta | duration -> ("extinf_duration", duration) :: meta in - let lines = Pcre.split ~pat:"\\s*-\\s*" song in + let lines = Pcre.split ~rex:(Pcre.regexp "\\s*-\\s*") song in meta @ match lines with @@ -75,7 +77,7 @@ let parse_extinf s = (* This parser cannot detect the format !! *) let parse_mpegurl ?pwd string = let lines = List.filter (fun x -> x <> "") (split_lines string) in - let is_info line = Pcre.pmatch ~pat:"^#EXTINF" line in + let is_info line = Pcre.pmatch ~rex:(Pcre.regexp "^#EXTINF") line in let skip_line line = line.[0] == '#' in let rec get_urls cur lines = match lines with @@ -90,10 +92,16 @@ let parse_mpegurl ?pwd string = get_urls [] lines let parse_scpls ?pwd string = - let string = Pcre.replace ~pat:"#[^\\r\\n]*[\\n\\r]+" string in + let string = + Pcre.substitute + ~rex:(Pcre.regexp "#[^\\r\\n]*[\\n\\r]+") + ~subst:(fun _ -> "") + string + in (* Format check, raise Not_found if invalid *) ignore - (Pcre.exec ~pat:"^[\\r\\n\\s]*\\[playlist\\]" + (Pcre.exec + ~rex:(Pcre.regexp "^[\\r\\n\\s]*\\[playlist\\]") (String.lowercase_ascii string)); let lines = split_lines string in let urls = @@ -226,7 +234,8 @@ let parse_cue ?pwd string = let strings = split_lines string in let strings = List.map - (fun string -> Pcre.replace ~rex:(Pcre.regexp "^\\s+") string) + (fun string -> + Pcre.substitute ~rex:(Pcre.regexp "^\\s+") ~subst:(fun _ -> "") string) strings in let strings = List.filter (fun s -> s <> "") strings in diff --git a/src/core/request.ml b/src/core/request.ml index 696c6dab23..25271e3d7c 100644 --- a/src/core/request.ml +++ b/src/core/request.ml @@ -23,6 +23,8 @@ (** Plug for resolving, that is obtaining a file from an URI. [src/protocols] plugins provide ways to resolve URIs: fetch, generate, ... *) +module Pcre = Re.Pcre + let conf = Dtools.Conf.void ~p:(Configure.conf#plug "request") "requests configuration" @@ -32,9 +34,11 @@ let log = Log.make ["request"] let remove_file_proto s = (* First remove file:// 🤮 *) - let s = Pcre.substitute ~pat:"^file://" ~subst:(fun _ -> "") s in + let s = + Pcre.substitute ~rex:(Pcre.regexp "^file://") ~subst:(fun _ -> "") s + in (* Then remove file: 😇 *) - Pcre.substitute ~pat:"^file:" ~subst:(fun _ -> "") s + Pcre.substitute ~rex:(Pcre.regexp "^file:") ~subst:(fun _ -> "") s let home_unrelate s = Lang_string.home_unrelate (remove_file_proto s) diff --git a/src/core/shebang.ml b/src/core/shebang.ml index 4d45b0e71f..3132acee65 100644 --- a/src/core/shebang.ml +++ b/src/core/shebang.ml @@ -56,7 +56,8 @@ let argv = [| Sys.argv.(1) |], Array.sub Sys.argv 2 (Array.length Sys.argv - 2) ) else - ( Array.of_list (Pcre.split ~pat:"\\s+" Sys.argv.(1)), + ( Array.of_list + (Re.Pcre.split ~rex:(Re.Pcre.regexp "\\s+") Sys.argv.(1)), [| Sys.argv.(2) |], Array.sub Sys.argv 3 (Array.length Sys.argv - 3) ) in diff --git a/src/core/source.ml b/src/core/source.ml index d740b197de..29b77ee11f 100644 --- a/src/core/source.ml +++ b/src/core/source.ml @@ -40,6 +40,8 @@ open Liquidsoap_lang.Error sources owned by those active sources, and controls access to their streams. *) +module Pcre = Re.Pcre + (** Fallibility type MUST be defined BEFORE clocks. Otherwise the module cannot be well-typed since the list of all clock variables refers to active sources and hence to #stype : source_t. @@ -333,7 +335,9 @@ class virtual operator ?pos ?(name = "src") sources = method id = id method set_id ?(definitive = true) s = - let s = Pcre.substitute ~pat:"[ \t\n.]" ~subst:(fun _ -> "_") s in + let s = + Pcre.substitute ~rex:(Pcre.regexp "[ \t\n.]") ~subst:(fun _ -> "_") s + in if not definitive_id then ( id <- Lang_string.generate_id s; definitive_id <- definitive); diff --git a/src/core/sources/harbor_input.ml b/src/core/sources/harbor_input.ml index 120bdc51ae..60ac9b504f 100644 --- a/src/core/sources/harbor_input.ml +++ b/src/core/sources/harbor_input.ml @@ -20,6 +20,8 @@ *****************************************************************************) +module Pcre = Re.Pcre + let address_resolver s = let s = Harbor.file_descr_of_socket s in Utils.name_of_sockaddr ~rev_dns:Harbor_base.conf_revdns#get @@ -175,7 +177,7 @@ class http_input_server ~pos ~transport ~dumpfile ~logfile ~bufferize ~max ~icy method register_decoder mime = let mime = try - let sub = Pcre.exec ~pat:"^([^;]+);.*$" mime in + let sub = Pcre.exec ~rex:(Pcre.regexp "^([^;]+);.*$") mime in Pcre.get_substring sub 1 with Not_found -> mime in diff --git a/src/core/tools/http.ml b/src/core/tools/http.ml index d4f06b4d59..2408d3860d 100644 --- a/src/core/tools/http.ml +++ b/src/core/tools/http.ml @@ -1,3 +1,5 @@ +module Pcre = Re.Pcre + type uri = { protocol : string; host : string; @@ -66,7 +68,7 @@ let user_agent = Configure.vendor let args_split s = let args = Hashtbl.create 2 in let fill_arg arg = - match Pcre.split ~pat:"=" arg with + match Pcre.split ~rex:(Pcre.regexp "=") arg with | e :: l -> (* There should be only arg=value *) List.iter @@ -76,7 +78,7 @@ let args_split s = l | [] -> () in - List.iter fill_arg (Pcre.split ~pat:"&" s); + List.iter fill_arg (Pcre.split ~rex:(Pcre.regexp "&") s); args let parse_url url = @@ -101,7 +103,8 @@ let parse_url url = let path = try Pcre.get_substring sub 4 with Not_found -> "/" in { protocol; host; port; path } -let is_url path = Pcre.pmatch ~pat:"^[Hh][Tt][Tt][Pp][sS]?://.+" path +let is_url path = + Pcre.pmatch ~rex:(Pcre.regexp "^[Hh][Tt][Tt][Pp][sS]?://.+") path let dirname url = let rex = Pcre.regexp "^([Hh][Tt][Tt][Pp][sS]?://.+/)[^/]*$" in @@ -165,8 +168,8 @@ let really_read ~timeout (socket : socket) len = (* Read chunked transfer. *) let read_chunked ~timeout (socket : socket) = let read = read_crlf ~count:1 ~timeout socket in - let len = List.hd (Pcre.split ~pat:"[\r]?\n" read) in - let len = List.hd (Pcre.split ~pat:";" len) in + let len = List.hd (Pcre.split ~rex:(Pcre.regexp "[\r]?\n") read) in + let len = List.hd (Pcre.split ~rex:(Pcre.regexp ";") len) in let len = int_of_string ("0x" ^ len) in let s = really_read socket ~timeout len in ignore (read_crlf ~count:1 ~timeout socket); diff --git a/src/core/tools/liqcurl.ml b/src/core/tools/liqcurl.ml index ce825fa713..94767a6f03 100644 --- a/src/core/tools/liqcurl.ml +++ b/src/core/tools/liqcurl.ml @@ -20,6 +20,8 @@ *****************************************************************************) +module Pcre = Re.Pcre + let () = Curl.global_init Curl.CURLINIT_GLOBALALL let string_of_curl_code = function @@ -205,7 +207,9 @@ let rec http_request ?headers ?http_version ~follow_redirect ~timeout ~url (fun ret header -> if header <> "" then ( try - let res = Pcre.exec ~pat:"([^:]*):\\s*(.*)" header in + let res = + Pcre.exec ~rex:(Pcre.regexp "([^:]*):\\s*(.*)") header + in ( String.lowercase_ascii (Pcre.get_substring res 1), Pcre.get_substring res 2 ) :: ret diff --git a/src/core/tools/sandbox.ml b/src/core/tools/sandbox.ml index 0c168d5151..7afef5b8f3 100644 --- a/src/core/tools/sandbox.ml +++ b/src/core/tools/sandbox.ml @@ -20,6 +20,8 @@ *****************************************************************************) +module Pcre = Re.Pcre + let log = Log.make ["sandbox"] let conf_sandbox = @@ -41,7 +43,7 @@ let conf_setenv = let get_setenv () = List.fold_left (fun cur s -> - match Pcre.split ~pat:"=" s with + match Pcre.split ~rex:(Pcre.regexp "=") s with | [] -> cur | lbl :: l -> (lbl, String.concat "=" l) :: cur) [] conf_setenv#get diff --git a/src/core/tools/server.ml b/src/core/tools/server.ml index 4e41b7fdf7..69f065d90b 100644 --- a/src/core/tools/server.ml +++ b/src/core/tools/server.ml @@ -20,6 +20,8 @@ *****************************************************************************) +module Pcre = Re.Pcre + let ( let* ) = Duppy.Monad.bind exception Bind_error of string @@ -233,7 +235,9 @@ let () = add "help" ~usage:"help []" ~descr:"Get information on available commands." (fun args -> try - let args = Pcre.substitute ~pat:"\\s*" ~subst:(fun _ -> "") args in + let args = + Pcre.substitute ~rex:(Pcre.regexp "\\s*") ~subst:(fun _ -> "") args + in let _, us, d = Tutils.mutexify lock (Hashtbl.find commands) args in Printf.sprintf "Usage: %s\r\n %s" us d with Not_found -> diff --git a/src/core/tools/tutils.ml b/src/core/tools/tutils.ml index 780e4e920d..36ee19673a 100644 --- a/src/core/tools/tutils.ml +++ b/src/core/tools/tutils.ml @@ -20,6 +20,8 @@ *****************************************************************************) +module Pcre = Re.Pcre + let conf_scheduler = Dtools.Conf.void ~p:(Configure.conf#plug "scheduler") @@ -216,7 +218,7 @@ let create ~queue f x s = (Printexc.to_string e); Printexc.raise_with_backtrace e raw_bt with e -> - let l = Pcre.split ~pat:"\n" bt in + let l = Pcre.split ~rex:(Pcre.regexp "\n") bt in List.iter (log#info "%s") l; mutexify lock (fun () -> diff --git a/src/core/tools/utils.ml b/src/core/tools/utils.ml index bcc2fe472b..4fbaeddac0 100644 --- a/src/core/tools/utils.ml +++ b/src/core/tools/utils.ml @@ -20,6 +20,7 @@ *****************************************************************************) +module Pcre = Re.Pcre include Liquidsoap_lang.Utils let select = if Sys.win32 then Unix.select else Duppy.poll @@ -287,7 +288,7 @@ let strftime ?time str : string = let key = Pcre.get_substring sub 1 in try List.assoc key assoc with _ -> "%" ^ key in - Pcre.substitute_substrings ~pat:"%(.)" ~subst str + Re.replace (Pcre.regexp "%(.)") ~f:subst str (** Check if a directory exists. *) let is_dir d = @@ -347,17 +348,22 @@ let uptime = (** Generate a string which can be used as a parameter name. *) let normalize_parameter_string s = let s = - Pcre.substitute ~pat:"( *\\([^\\)]*\\)| *\\[[^\\]]*\\])" + Pcre.substitute + ~rex:(Pcre.regexp "( *\\([^\\)]*\\)| *\\[[^\\]]*\\])") ~subst:(fun _ -> "") s in - let s = Pcre.substitute ~pat:"(\\.+|\\++)" ~subst:(fun _ -> "") s in - let s = Pcre.substitute ~pat:" +$" ~subst:(fun _ -> "") s in - let s = Pcre.substitute ~pat:"( +|/+|-+)" ~subst:(fun _ -> "_") s in - let s = Pcre.substitute ~pat:"\"" ~subst:(fun _ -> "") s in + let s = + Pcre.substitute ~rex:(Pcre.regexp "(\\.+|\\++)") ~subst:(fun _ -> "") s + in + let s = Pcre.substitute ~rex:(Pcre.regexp " +$") ~subst:(fun _ -> "") s in + let s = + Pcre.substitute ~rex:(Pcre.regexp "( +|/+|-+)") ~subst:(fun _ -> "_") s + in + let s = Pcre.substitute ~rex:(Pcre.regexp "\"") ~subst:(fun _ -> "") s in let s = String.lowercase_ascii s in (* Identifiers cannot begin with a digit. *) - let s = if Pcre.pmatch ~pat:"^[0-9]" s then "_" ^ s else s in + let s = if Pcre.pmatch ~rex:(Pcre.regexp "^[0-9]") s then "_" ^ s else s in s (** A function to reopen a file descriptor @@ -436,35 +442,6 @@ let self_sync_type sources = | _ -> (`Dynamic, None)) (`Static, None) sources)) -let string_of_pcre_error = - Pcre.( - function - | Partial -> "String only matched the pattern partially" - | BadPartial -> - "Pattern contains items that cannot be used together with partial \ - matching." - | BadPattern (msg, pos) -> - Printf.sprintf "Malformed regular expression. Error: %s, position: %i" - msg pos - | BadUTF8 -> "UTF8 string being matched is invalid" - | BadUTF8Offset -> "A UTF8 string being matched with offset is invalid." - | MatchLimit -> - "Maximum allowed number of match attempts with backtracking or \ - recursion is reached during matching." - | RecursionLimit -> "Maximum allowed number of recursion reached" - | InternalError msg -> Printf.sprintf "Internal error: %s" msg - (* This is a hack to be extensible here and enable warning 11 *) - | exn -> - if exn == WorkspaceSize then "Provided workspace array is too small" - else "Unknown error") - -let () = - Printexc.register_printer - Pcre.( - function - | Error err -> Some (Printf.sprintf "Pcre(%s)" (string_of_pcre_error err)) - | _ -> None) - let var_script = ref "default" let substs = diff --git a/src/js/dune b/src/js/dune index 5eb81cac9e..b023c2265b 100644 --- a/src/js/dune +++ b/src/js/dune @@ -7,7 +7,7 @@ (name liquidsoap_js) (public_name liquidsoap-js) (optional) - (modules init_js regexp_js) + (modules init_js) (preprocess (pps js_of_ocaml-ppx)) (libraries liquidsoap_lang liquidsoap_tooling)) diff --git a/src/js/init_js.ml b/src/js/init_js.ml index ef9735fa45..fbe16302a7 100644 --- a/src/js/init_js.ml +++ b/src/js/init_js.ml @@ -1,6 +1,5 @@ open Liquidsoap_lang let () = - Hooks.regexp := Regexp_js.make; (Hooks.liq_libs_dir := fun () -> "/static"); Runtime.load_libs ~stdlib:"stdlib_js.liq" () diff --git a/src/js/regexp_js.ml b/src/js/regexp_js.ml deleted file mode 100644 index 54994ba8dd..0000000000 --- a/src/js/regexp_js.ml +++ /dev/null @@ -1,57 +0,0 @@ -open Js_of_ocaml - -type sub = Liquidsoap_lang.Regexp.sub = { - matches : string option list; - groups : (string * string) list; -} - -class type match_result = - object - inherit Js.match_result - method groups : Js.Unsafe.any Js.optdef Js.readonly_prop - end - -let string_of_flag = function `i -> "i" | `g -> "g" | `s -> "s" | `m -> "m" - -let flags_of_flags flags = - Js.string (String.concat "" (List.map string_of_flag flags)) - -let make ?(flags = []) s = - let rex = new%js Js.regExp_withFlags (Js.string s) (flags_of_flags flags) in - object - method split s = - let split = (Js.string s)##split_regExp rex in - let split = Js.str_array split in - Array.to_list (Array.map Js.to_string (Js.to_array split)) - - method exec s = - let s = Js.string s in - let ret = - Js.Opt.case (rex##exec s) (fun () -> raise Not_found) (fun x -> x) - in - let sub : match_result Js.t = Js.Unsafe.coerce (Js.match_result ret) in - let matches = - List.init sub##.length (fun pos -> - Option.map Js.to_string (Js.Optdef.to_option (Js.array_get sub pos))) - in - let groups = - Js.Optdef.case sub##.groups - (fun () -> []) - (fun groups -> - let names = Js.to_array (Js.object_keys groups) in - Array.fold_left - (fun cur key -> - Js.Optdef.case (Js.Unsafe.get groups key) - (fun () -> cur) - (fun value -> (Js.to_string key, Js.to_string value) :: cur)) - [] names) - in - { matches; groups } - - method test s = Js.to_bool (rex##test (Js.string s)) - - method substitute ~subst s = - let subst a = Js.string (subst (Js.to_string a)) in - let subst = Js.wrap_callback subst in - Js.to_string ((Js.Unsafe.coerce (Js.string s))##replace rex subst) - end diff --git a/src/js/regexp_js.mli b/src/js/regexp_js.mli deleted file mode 100644 index 811a9a68fb..0000000000 --- a/src/js/regexp_js.mli +++ /dev/null @@ -1,4 +0,0 @@ -val make : - ?flags:Liquidsoap_lang.Regexp.flag list -> - string -> - Liquidsoap_lang.Regexp.regexp diff --git a/src/lang/builtins_regexp.ml b/src/lang/builtins_regexp.ml index ac947e31dd..da23e0f5e3 100644 --- a/src/lang/builtins_regexp.ml +++ b/src/lang/builtins_regexp.ml @@ -23,10 +23,10 @@ type regexp = { descr : string; flags : [ `i | `g | `s | `m ] list; - regexp : Regexp.t; + regexp : Re.re; } -let all_regexp_flags = [`i; `g; `s; `m] +let all_regexp_flags = [`i; `g; `m] let string_of_regexp_flag = function | `i -> "i" @@ -77,24 +77,33 @@ end) let test_t = Lang_core.fun_t [(false, "", Lang_core.string_t)] Lang_core.bool_t -let test_fun rex = +let test_fun ~flags:_ ~descr:_ rex = Lang_core.val_fun [("", "", None)] (fun p -> let string = Lang_core.to_string (List.assoc "" p) in - Lang_core.bool (Regexp.test rex string)) + Lang_core.bool (Re.Pcre.pmatch ~rex string)) let split_t = Lang_core.fun_t [(false, "", Lang_core.string_t)] (Lang_core.list_t Lang_core.string_t) -let split_fun rex = +let split_fun ~flags:_ ~descr rex = Lang_core.val_fun [("", "", None)] (fun p -> let string = Lang_core.to_string (List.assoc "" p) in - Lang_core.list (List.map Lang_core.string (Regexp.split rex string))) + Lang_core.list + (match (descr, string) with + (* See: https://github.com/ocaml/ocaml-re/issues/232 *) + | "", _ -> + List.map + (fun c -> Lang_core.string (Printf.sprintf "%c" c)) + (List.of_seq (String.to_seq string)) + (* See: https://github.com/ocaml/ocaml-re/issues/215 *) + | _, "" -> [Lang_core.string ""] + | _ -> List.map Lang_core.string (Re.Pcre.split ~rex string))) let exec_t = let matches_t = @@ -111,14 +120,18 @@ let exec_t = "Named captures" ); ]) -let exec_fun regexp = +let exec_fun ~flags:_ ~descr:_ rex = Lang_core.val_fun [("", "", None)] (fun p -> let string = Lang_core.to_string (List.assoc "" p) in try - let { Regexp.matches; groups } = Regexp.exec regexp string in + let sub = Re.Pcre.exec ~rex string in let matches = + let matches = + Array.to_list + @@ Array.init (Re.Group.nb_groups sub + 1) (Re.Group.get_opt sub) + in Lang_core.list (List.fold_left (fun matches (pos, value) -> @@ -135,11 +148,16 @@ let exec_fun regexp = [ ( "groups", Lang_core.list - (List.map - (fun (name, value) -> - Lang_core.product (Lang_core.string name) - (Lang_core.string value)) - groups) ); + (List.fold_left + (fun groups name -> + try + Lang_core.product (Lang_core.string name) + (Lang_core.string + (Re.Pcre.get_named_substring rex name sub)) + :: groups + with Not_found -> groups) + [] + (Array.to_list (Re.Pcre.names rex))) ); ] with | Not_found -> @@ -161,7 +179,7 @@ let replace_t = ] Lang_core.string_t -let replace_fun regexp = +let replace_fun ~flags ~descr:_ regexp = Lang_core.val_fun [("", "", None); ("", "", None)] (fun p -> @@ -172,7 +190,10 @@ let replace_fun regexp = in let string = Lang_core.to_string (Lang_core.assoc "" 2 p) in let string = - try Regexp.substitute regexp ~subst string + try + Re.replace ~all:(List.mem `g flags) + ~f:(fun g -> subst (Re.Group.get g 0)) + regexp string with exn -> Runtime_error.raise ~message: @@ -233,7 +254,18 @@ let _ = in let descr = Lang_core.to_string (List.assoc "" p) in let regexp = - match Regexp.regexp ~flags descr with + let flags = + List.fold_left + (fun l f -> + match f with + | `i -> `CASELESS :: l + (* `g is handled at the call level. *) + | `g -> l + | `s -> `DOTALL :: l + | `m -> `MULTILINE :: l) + [] flags + in + match Re.Pcre.regexp ~flags descr with | v -> v | exception exn -> Runtime_error.raise @@ -243,5 +275,7 @@ let _ = ~pos:(Lang_core.pos p) "string" in let v = RegExp.to_value { descr; flags; regexp } in - let meth = List.map (fun (name, _, _, fn) -> (name, fn regexp)) meth in + let meth = + List.map (fun (name, _, _, fn) -> (name, fn ~flags ~descr regexp)) meth + in Lang_core.meth v meth) diff --git a/src/lang/builtins_string.ml b/src/lang/builtins_string.ml index 235f6f8158..fc2b3dd5c9 100644 --- a/src/lang/builtins_string.ml +++ b/src/lang/builtins_string.ml @@ -370,7 +370,7 @@ let _ = in Lang.string (if space_sensitive then ( - let l = Regexp.split (Regexp.regexp " ") string in + let l = Re.Pcre.split ~rex:(Re.Pcre.regexp " ") string in let l = List.map f l in String.concat " " l) else f string)) diff --git a/src/lang/doc.ml b/src/lang/doc.ml index c0a4128052..ee60e5051b 100644 --- a/src/lang/doc.ml +++ b/src/lang/doc.ml @@ -491,10 +491,7 @@ let parse_doc ~pos doc = let doc = List.map (fun x -> - Regexp.substitute - (Regexp.regexp ~flags:[`g] "^\\s*#\\s?") - ~subst:(fun _ -> "") - x) + Re.replace ~all:true ~f:(fun _ -> "") (Re.Pcre.regexp "^\\s*#\\s?") x) doc in if doc = [] then None @@ -504,13 +501,14 @@ let parse_doc ~pos doc = | line :: lines -> ( try let sub = - Regexp.exec - (Regexp.regexp - "^\\s*@(category|docof|flag|param|method|argsof)\\s*(.*)$") + Re.Pcre.exec + ~rex: + (Re.Pcre.regexp + "^\\s*@(category|docof|flag|param|method|argsof)\\s*(.*)$") line in - let s = Option.get (List.nth sub.Regexp.matches 2) in - match Option.get (List.nth sub.Regexp.matches 1) with + let s = Re.Pcre.get_substring sub 2 in + match Re.Pcre.get_substring sub 1 with | "docof" -> let doc = Value.get s in let main = @@ -539,17 +537,18 @@ let parse_doc ~pos doc = let s, only, except = try let sub = - Regexp.exec - (Regexp.regexp "^\\s*([^\\[]+)\\[([^\\]]+)\\]\\s*$") + Re.Pcre.exec + ~rex: + (Re.Pcre.regexp "^\\s*([^\\[]+)\\[([^\\]]+)\\]\\s*$") s in - let s = Option.get (List.nth sub.Regexp.matches 1) in + let s = Re.Pcre.get_substring sub 1 in let args = List.filter (fun s -> s <> "") (List.map String.trim (String.split_on_char ',' - (Option.get (List.nth sub.Regexp.matches 2)))) + (Re.Pcre.get_substring sub 2))) in let only, except = List.fold_left @@ -592,10 +591,12 @@ let parse_doc ~pos doc = parse_doc (main, `Flag s :: special, params, methods) lines | "param" -> let sub = - Regexp.exec (Regexp.regexp "^(~?[a-zA-Z0-9_.]+)\\s*(.*)$") s + Re.Pcre.exec + ~rex:(Re.Pcre.regexp "^(~?[a-zA-Z0-9_.]+)\\s*(.*)$") + s in - let label = Option.get (List.nth sub.Regexp.matches 1) in - let descr = Option.get (List.nth sub.Regexp.matches 2) in + let label = Re.Pcre.get_substring sub 1 in + let descr = Re.Pcre.get_substring sub 2 in let label = if label.[0] = '~' then Some (String.sub label 1 (String.length label - 1)) @@ -606,10 +607,9 @@ let parse_doc ~pos doc = | [] -> raise Not_found | line :: lines -> let line = - Regexp.substitute - (Regexp.regexp ~flags:[`g] "^ *") - ~subst:(fun _ -> "") - line + Re.replace ~all:true + ~f:(fun _ -> "") + (Re.Pcre.regexp "^ *") line in let n = String.length line - 1 in if line.[n] = '\\' then ( @@ -625,10 +625,12 @@ let parse_doc ~pos doc = lines | "method" -> let sub = - Regexp.exec (Regexp.regexp "^(~?[a-zA-Z0-9_.]+)\\s*(.*)$") s + Re.Pcre.exec + ~rex:(Re.Pcre.regexp "^(~?[a-zA-Z0-9_.]+)\\s*(.*)$") + s in - let label = Option.get (List.nth sub.Regexp.matches 1) in - let descr = Option.get (List.nth sub.Regexp.matches 2) in + let label = Re.Pcre.get_substring sub 1 in + let descr = Re.Pcre.get_substring sub 2 in parse_doc (main, special, params, (label, descr) :: methods) lines diff --git a/src/lang/dune b/src/lang/dune index 2857d0504b..f49bee8607 100644 --- a/src/lang/dune +++ b/src/lang/dune @@ -82,7 +82,7 @@ (public_name liquidsoap-lang) (preprocess (pps sedlex.ppx ppx_string)) - (libraries liquidsoap-lang.console dune-site str unix menhirLib) + (libraries liquidsoap-lang.console dune-site re str unix menhirLib) (modules build_config builtins_bool @@ -126,7 +126,6 @@ profiler repr ref_type - regexp runtime runtime_error runtime_term diff --git a/src/lang/hooks.ml b/src/lang/hooks.ml index 0050922783..0dfc92758d 100644 --- a/src/lang/hooks.ml +++ b/src/lang/hooks.ml @@ -14,7 +14,6 @@ let has_encoder = ref (fun _ -> false) let liq_libs_dir = ref (fun () -> raise Not_found) let log_path = ref None let collect_after = ref (fun fn -> fn ()) -let regexp = Regexp.regexp_ref type log = < f : 'a. int -> ('a, unit, string, unit) format4 -> 'a diff --git a/src/lang/hooks.mli b/src/lang/hooks.mli index 7cfc0d1a7a..446149c3ba 100644 --- a/src/lang/hooks.mli +++ b/src/lang/hooks.mli @@ -1,7 +1,5 @@ (* Language essentials *) -val regexp : (?flags:Regexp.flag list -> string -> Regexp.regexp) ref - type log = < f : 'a. int -> ('a, unit, string, unit) format4 -> 'a ; critical : 'a. ('a, unit, string, unit) format4 -> 'a diff --git a/src/lang/lang.mli b/src/lang/lang.mli index 37429c200b..34c5f69e00 100644 --- a/src/lang/lang.mli +++ b/src/lang/lang.mli @@ -27,7 +27,7 @@ type t = Type.t type module_name type scheme = Type.scheme -type regexp +type regexp = Builtins_regexp.regexp (** {2 Values} *) @@ -244,12 +244,3 @@ val descr_of_regexp : regexp -> string (** Return a string description of a regexp value i.e. r/^foo\/bla$/g *) val string_of_regexp : regexp -> string - -module Regexp : sig - include Regexp.T with type t := regexp - - type sub = Regexp.sub = { - matches : string option list; - groups : (string * string) list; - } -end diff --git a/src/lang/lang_regexp.ml b/src/lang/lang_regexp.ml index f55d53e5b1..2468db4185 100644 --- a/src/lang/lang_regexp.ml +++ b/src/lang/lang_regexp.ml @@ -5,20 +5,3 @@ let to_regexp = Builtins_regexp.RegExp.of_value let regexp = Builtins_regexp.RegExp.to_value ?pos:None let descr_of_regexp { Builtins_regexp.descr; _ } = descr let string_of_regexp = Builtins_regexp.string_of_regexp - -module Regexp = struct - type sub = Regexp.sub = { - matches : string option list; - groups : (string * string) list; - } - - let get_rex { Builtins_regexp.regexp } = regexp - - let regexp ?(flags = []) s = - { Builtins_regexp.descr = s; flags; regexp = Regexp.regexp s } - - let split rex = Regexp.split (get_rex rex) - let exec rex = Regexp.exec (get_rex rex) - let test rex = Regexp.test (get_rex rex) - let substitute rex = Regexp.substitute (get_rex rex) -end diff --git a/src/lang/lang_string.ml b/src/lang/lang_string.ml index b44f657819..d91f841525 100644 --- a/src/lang/lang_string.ml +++ b/src/lang/lang_string.ml @@ -234,9 +234,10 @@ let unescape_char = function | s when String.length s = 4 -> unescape_octal_char s | _ -> assert false -let unescape_string s = - let rex = Regexp.regexp ~flags:[`g] (String.concat "|" unescape_patterns) in - Regexp.substitute rex ~subst:unescape_char s +let unescape_string = + Re.replace ~all:true + ~f:(fun g -> unescape_char (Re.Group.get g 0)) + (Re.Pcre.regexp (String.concat "|" unescape_patterns)) (** String representation of a matrix of strings. *) let string_of_matrix a = @@ -345,10 +346,10 @@ module Version = struct (* We assume something like, 2.0.0+git@7e211ffd *) let of_string s : t = - let rex = Regexp.regexp "([\\.\\d]+)([^\\.]+)?" in - let sub = Regexp.exec rex s in - let num = Option.get (List.nth sub.Regexp.matches 1) in - let str = Option.value ~default:"" (List.nth sub.Regexp.matches 2) in + let rex = Re.Pcre.regexp "([\\.\\d]+)([^\\.]+)?" in + let sub = Re.Pcre.exec ~rex s in + let num = Re.Pcre.get_substring sub 1 in + let str = try Re.Pcre.get_substring sub 2 with _ -> "" in let num = String.split_on_char '.' num |> List.map int_of_string in (num, str) @@ -532,13 +533,14 @@ let to_hex2 = Bytes.unsafe_to_string s let url_encode ?(plus = true) s = - Regexp.substitute - (Regexp.regexp ~flags:[`g] "[^A-Za-z0-9_.!*-]") - ~subst:(fun x -> + Re.replace ~all:true + ~f:(fun g -> + let x = Re.Group.get g 0 in if plus && x = " " then "+" else ( let k = Char.code x.[0] in "%" ^ to_hex2 k)) + (Re.Pcre.regexp "[^A-Za-z0-9_.!*-]") s let of_hex1 c = @@ -549,10 +551,10 @@ let of_hex1 c = | _ -> failwith "invalid url" let url_decode ?(plus = true) s = - Regexp.substitute - (Regexp.regexp ~flags:[`g] "\\+|%..|%.|%") - (* TODO why do we match %. and % and seem to exclude them below ? *) - ~subst:(fun s -> + let rex = Re.Pcre.regexp "\\+|%..|%.|%" in + Re.replace ~all:true + ~f:(fun g -> + let s = Re.Group.get g 0 in if s = "+" then if plus then " " else "+" else ( (* Assertion: s.[0] = '%' *) @@ -560,4 +562,4 @@ let url_decode ?(plus = true) s = let k1 = of_hex1 s.[1] in let k2 = of_hex1 s.[2] in String.make 1 (Char.chr ((k1 lsl 4) lor k2)))) - s + rex s diff --git a/src/lang/lexer.ml b/src/lang/lexer.ml index 84c92f3c7c..c4cec2518d 100644 --- a/src/lang/lexer.ml +++ b/src/lang/lexer.ml @@ -53,24 +53,23 @@ let parse_time t = (function | None | Some "" -> None | Some s -> Some (int_of_string (String.sub s 0 (String.length s - 1)))) - (List.nth sub.Regexp.matches n) + (try Some (Re.Pcre.get_substring sub n) with _ -> None) in try let rex = - Regexp.regexp "^((?:\\d+w)?)((?:\\d+h)?)((?:\\d+m)?)((?:\\d+s)?)$" + Re.Pcre.regexp "^((?:\\d+w)?)((?:\\d+h)?)((?:\\d+m)?)((?:\\d+s)?)$" in - let sub = Regexp.exec rex t in + let sub = Re.Pcre.exec ~rex t in let g = g sub in { Parsed_term.week = g 1; hours = g 2; minutes = g 3; seconds = g 4 } with Not_found -> - let rex = Regexp.regexp "^((?:\\d+w)?)(\\d+h)(\\d+)$" in - let sub = Regexp.exec rex t in + let rex = Re.Pcre.regexp "^((?:\\d+w)?)(\\d+h)(\\d+)$" in + let sub = Re.Pcre.exec ~rex t in let g = g sub in { Parsed_term.week = g 1; hours = g 2; - minutes = - Some (int_of_string (Option.get (List.nth sub.Regexp.matches 3))); + minutes = Some (int_of_string (Re.Pcre.get_substring sub 3)); seconds = None; } diff --git a/src/lang/preprocessor.ml b/src/lang/preprocessor.ml index 3fbb93ffad..5cb7cf4488 100644 --- a/src/lang/preprocessor.ml +++ b/src/lang/preprocessor.ml @@ -33,26 +33,38 @@ let mk_tokenizer ?(fname = "") lexbuf = (* The expander turns "bla #{e} bli" into ("bla "^string(e)^" bli"). *) type exp_item = String of string | Expr of tokenizer | End +exception Found_interpolation + let expand_string ?fname tokenizer = let state = Queue.create () in let add pos x = Queue.add (x, pos) state in let pop () = ignore (Queue.take state) in let clear () = Queue.clear state in + let is_interpolating () = + try + Queue.iter + (function Expr _, _ -> raise Found_interpolation | _ -> ()) + state; + false + with Found_interpolation -> true + in let parse ~sep s pos = - let l = Regexp.split (Regexp.regexp "#{([^}]*)}") s in - let l = if l = [] then [""] else l in + let rex = Re.Pcre.regexp "#\\{([^}]*)\\}" in + let l = Re.Pcre.full_split ~rex s in + let l = if l = [] then [Re.Pcre.Text s] else l in let add = add pos in let rec parse = function - | s :: x :: l -> + | Re.Pcre.Group (_, x) :: l -> let x = Lexer.render_string ~pos ~sep x in let lexbuf = Sedlexing.Utf8.from_string x in let tokenizer = mk_tokenizer ?fname lexbuf in let tokenizer () = (fst (tokenizer ()), pos) in - List.iter add [String s; Expr tokenizer]; + add (Expr tokenizer); parse l - | x :: l -> + | Re.Pcre.Text x :: l -> add (String x); parse l + | Re.Pcre.NoGroup :: l | Re.Pcre.Delim _ :: l -> parse l | [] -> add End in parse l @@ -62,7 +74,7 @@ let expand_string ?fname tokenizer = match tokenizer () with | (Parser.STRING (sep, s), pos) as tok -> parse ~sep s pos; - if Queue.length state > 2 then (Parser.BEGIN_INTERPOLATION sep, pos) + if is_interpolating () then (Parser.BEGIN_INTERPOLATION sep, pos) else ( clear (); tok) diff --git a/src/lang/regexp.ml b/src/lang/regexp.ml deleted file mode 100644 index 27d36b8d84..0000000000 --- a/src/lang/regexp.ml +++ /dev/null @@ -1,39 +0,0 @@ -type flag = [ `i | `g | `s | `m ] -type sub = { matches : string option list; groups : (string * string) list } - -module type T = sig - type t - - val regexp : ?flags:flag list -> string -> t - val split : t -> string -> string list - val exec : t -> string -> sub - val test : t -> string -> bool - val substitute : t -> subst:(string -> string) -> string -> string -end - -type t = - < split : string -> string list - ; exec : string -> sub - ; test : string -> bool - ; substitute : subst:(string -> string) -> string -> string > - -type regexp = t - -let dummy_regexp ?flags:_ _ = - object - method split _ = assert false - method exec _ = assert false - method test _ = assert false - method substitute ~subst:_ _ = assert false - end - -let regexp_ref = ref dummy_regexp - -let regexp ?flags s = - let fn = !regexp_ref in - fn ?flags s - -let split rex = rex#split -let exec rex = rex#exec -let test rex = rex#test -let substitute rex = rex#substitute diff --git a/src/lang/regexp.mli b/src/lang/regexp.mli deleted file mode 100644 index 3deca1ea48..0000000000 --- a/src/lang/regexp.mli +++ /dev/null @@ -1,26 +0,0 @@ -(* Operational module: *) - -type flag = [ `i | `g | `s | `m ] -type sub = { matches : string option list; groups : (string * string) list } - -module type T = sig - type t - - val regexp : ?flags:flag list -> string -> t - val split : t -> string -> string list - val exec : t -> string -> sub - val test : t -> string -> bool - val substitute : t -> subst:(string -> string) -> string -> string -end - -include T - -(* Implementation, filled by language user: *) - -type regexp = - < split : string -> string list - ; exec : string -> sub - ; test : string -> bool - ; substitute : subst:(string -> string) -> string -> string > - -val regexp_ref : (?flags:flag list -> string -> regexp) ref diff --git a/src/runtime/main.ml b/src/runtime/main.ml index 8acea60795..ef8ff2b8d0 100644 --- a/src/runtime/main.ml +++ b/src/runtime/main.ml @@ -20,6 +20,7 @@ *****************************************************************************) +module Pcre = Re.Pcre module Runtime = Liquidsoap_lang.Runtime module Doc = Liquidsoap_lang.Doc module Environment = Liquidsoap_lang.Environment @@ -205,7 +206,7 @@ let format_doc s = let prefix = "\t " in let indent = 8 + 2 in let max_width = 80 in - let s = Pcre.split ~pat:" " s in + let s = Pcre.split ~rex:(Pcre.regexp " ") s in let s = let rec join line width = function | [] -> [line] diff --git a/tests/harbor/http.liq b/tests/harbor/http.liq index 5661c22c88..5bac29d4c8 100644 --- a/tests/harbor/http.liq +++ b/tests/harbor/http.liq @@ -35,7 +35,7 @@ def f() = test.equals(req.http_version, "1.1") test.equals(req.method, "GET") test.equals(req.body(timeout=5.0), "") - test.equals(req.query, [("gni", "gno"), ("bla", "blo")]) + test.equals(req.query, [("bla", "blo"), ("gni", "gno")]) test.equals(req.path, "/path/gno/blo") end @@ -53,7 +53,7 @@ def f() = test.equals(req.method, "POST") test.equals( req.query, - [("foo", "with"), ("bla", "in"), ("gnu", "gno"), ("gni", "gno")] + [("bla", "in"), ("foo", "with"), ("gnu", "gno"), ("gni", "gno")] ) test.equals( diff --git a/tests/language/eval.liq b/tests/language/eval.liq index 0e26a898c1..3285f8e283 100644 --- a/tests/language/eval.liq +++ b/tests/language/eval.liq @@ -3,22 +3,14 @@ count = ref(1) fail = ref(false) def echo(s) = + print(s) if s != string(count()) then fail := true end count := count() + 1 () end def t(lbl, f) = - if - f() - then - echo(lbl) - else - echo( - "fail " ^ - lbl - ) - end + if f() then echo(lbl) else echo("fail #{lbl}") end end def f() = @@ -36,29 +28,28 @@ def f() = t("11", {2 == list.length(r//.split(l["blo"]))}) echo("1#{1 + 1}") echo(string(int_of_float(float_of_string(default=13., "blah")))) + f = fun (x) -> x # Checking that the following is not recursive: f = fun (x) -> f(x) + echo(string(f(14))) t("15", {list.remove(2, [2]) == []}) t("16", {"bla" == (true ? "bla" : "foo" )}) t("17", {"foo" == (false ? "bla" : "foo" )}) # Generic eval - let eval x = - "{foo = 123, gni = \"aabbcc\"}" + let eval x = "{foo = 123, gni = \"aabbcc\"}" t("18", {x.foo == 123}) t("19", {x.gni == "aabbcc"}) # Eval with sources! - let eval x = - "output.dummy(id='bla', blank())" + let eval x = "output.dummy(id='bla', blank())" t("20", {x.id() == "bla"}) # Eval with patterns - let eval {foo, gni = [x, y]} = - "{foo = 123, gni = [1,2]}" + let eval {foo, gni = [x, y]} = "{foo = 123, gni = [1,2]}" t("21", {foo == 123}) t("22", {gni == [1, 2]}) t("23", {x == 1})