From b8ca9aeb5d57302d2af8d9accc02ce4678d61f70 Mon Sep 17 00:00:00 2001 From: Paul Monson Date: Sat, 28 Oct 2023 09:25:28 -0500 Subject: [PATCH 01/12] Update makefile and depdencies --- Makefile | 79 ++++++++++++++++++++++--------------------------- bin_test/help.t | 2 +- 2 files changed, 37 insertions(+), 44 deletions(-) diff --git a/Makefile b/Makefile index 08fd845..ed7d1f3 100644 --- a/Makefile +++ b/Makefile @@ -1,70 +1,63 @@ +OPAM_SWITCH_VER=5.0.0 +RELEASE_NAME!=git describe --tags --always --abbrev=7 +RELEASE_NAME ?= $(shell git describe --tags --always --abbrev=7) + .PHONY: build -build: - @dune build @all -j8 +build: deps + @opam exec -- dune build @all -j8 .PHONY: build-js build-js: - @dune build fex_js/fex.bc.js --profile=release -j8 - -.PHONY: install-deps -install-deps: - @opam install . --deps-only --with-doc --with-test - -.PHONY: update -update: - opam update - -.PHONY: upgrade -upgrade: - opam upgrade - -.PHONY: lock -lock: - opam lock -d fex - -.PHONY: update-deps -update-deps: update upgrade lock + @opam exec -- dune build fex_js/fex.bc.js --profile=release -j8 .PHONY: watch watch: - @dune build @all --watch -j8 + @opam exec -- dune build @all --watch -j8 .PHONY: build-js watch-js: - @dune build fex_js/fex.bc.js --profile=release -w -j8 - -.PHONY: install -install: - @dune install + @opam exec -- dune build fex_js/fex.bc.js --profile=release -w -j8 .PHONY: test test: - @dune runtest --force + @opam exec -- dune runtest --force .PHONY: watch-test watch-test: - @dune runtest -w + @opam exec -- dune runtest -w .PHONY: coverage coverage: - @dune runtest --instrument-with bisect_ppx --force - @bisect-ppx-report summary --per-file - @bisect-ppx-report html + @opam exec -- dune runtest --instrument-with bisect_ppx --force + @opam exec -- bisect-ppx-report summary --per-file + @opam exec -- bisect-ppx-report html -.PHONY: fmt +.PHONY: format format: - @dune build @fmt --auto-promote + @opam exec -- dune build @fmt --auto-promote .PHONY: clean clean: @dune clean @rm -Rf _coverage -.PHONY: doc -doc: - @dune build @doc - -.PHONY: doc-serve -doc-serve: - @dune build @doc -w & - @(cd _build/default/_doc/_html/; cohttp-server-lwt) +.PHONY: create-switch +create-switch: _opam/.opam-switch/config/ocaml.config + @echo "current switch: $$(opam switch show)" + +.PHONY: setup +setup: create-switch + -opam install dune + -opam install ocaml-lsp-server ocamlformat odig utop bisect_ppx + -opam exec -- dune build @install + opam install . --deps-only --with-test + +.PHONY: deps +deps: create-switch + @if ! opam install . --check --deps-only; then \ + echo "Fetching and building deps..."; \ + opam install . --deps-only --yes; \ + fi; + +_opam/.opam-switch/config/ocaml.config: + -opam switch create . ${OPAM_SWITCH_VER} --deps-only --yes 2>>/dev/null diff --git a/bin_test/help.t b/bin_test/help.t index c135b16..4166688 100644 --- a/bin_test/help.t +++ b/bin_test/help.t @@ -29,7 +29,7 @@ Show version information. EXIT STATUS - fex exits with the following status: + fex exits with: 0 on success. From 20e56c03c72c546d55e0dff767de6edfe5e2df3a Mon Sep 17 00:00:00 2001 From: Paul Monson Date: Sun, 17 Dec 2023 15:09:27 -0600 Subject: [PATCH 02/12] Minor clean ups --- .github/workflows/workflow.yml | 8 +------- Makefile | 12 ++---------- bin/fex.ml | 13 +++++++++---- fex_js/dune | 6 ------ fex_js/fex.ml | 29 ----------------------------- fex_js_test/dune | 0 fex_js_test/example.t | 2 -- 7 files changed, 12 insertions(+), 58 deletions(-) delete mode 100644 fex_js/dune delete mode 100644 fex_js/fex.ml delete mode 100644 fex_js_test/dune delete mode 100644 fex_js_test/example.t diff --git a/.github/workflows/workflow.yml b/.github/workflows/workflow.yml index 4f608d6..f0e787e 100644 --- a/.github/workflows/workflow.yml +++ b/.github/workflows/workflow.yml @@ -1,7 +1,7 @@ --- name: Main workflow -on: +"on": - pull_request jobs: @@ -33,9 +33,3 @@ jobs: - run: opam exec -- dune runtest --instrument-with bisect_ppx --force - run: opam exec -- bisect-ppx-report summary --per-file - - - name: Upload the build artifact - uses: actions/upload-artifact@v2 - with: - name: ${{ matrix.os }}-${{ matrix.ocaml-version }}-fex.exe - path: _build/default/bin/fex.exe diff --git a/Makefile b/Makefile index ed7d1f3..2777cde 100644 --- a/Makefile +++ b/Makefile @@ -1,23 +1,15 @@ OPAM_SWITCH_VER=5.0.0 -RELEASE_NAME!=git describe --tags --always --abbrev=7 -RELEASE_NAME ?= $(shell git describe --tags --always --abbrev=7) +RELEASE_NAME!=git describe --tags --always --dirty --abbrev=7 +RELEASE_NAME ?= $(shell git describe --tags --always --dirty --abbrev=7) .PHONY: build build: deps @opam exec -- dune build @all -j8 -.PHONY: build-js -build-js: - @opam exec -- dune build fex_js/fex.bc.js --profile=release -j8 - .PHONY: watch watch: @opam exec -- dune build @all --watch -j8 -.PHONY: build-js -watch-js: - @opam exec -- dune build fex_js/fex.bc.js --profile=release -w -j8 - .PHONY: test test: @opam exec -- dune runtest --force diff --git a/bin/fex.ml b/bin/fex.ml index 620ace7..e49b874 100644 --- a/bin/fex.ml +++ b/bin/fex.ml @@ -17,15 +17,20 @@ let fex_record_op fex json = exit 124 in let print_for_pairs filter_lst pairs = - if Fex_compiler.apply_list_filter_for_pairs filter_lst pairs then + if Fex_compiler.apply_list_filter_for_pairs filter_lst pairs then ( try List.iter sprint_pair pairs ; print_newline () with | Invalid_argument a -> - print_endline a ; - print_endline "fuck off" - | _ -> print_endline "shit" + let stack = Printexc.get_backtrace () in + Printf.eprintf "Argument Error [%s] %s\n" a stack ; + exit 124 + | e -> + let msg = Printexc.to_string e + and stack = Printexc.get_backtrace () in + Printf.eprintf "Error %s%s\n" msg stack ; + exit 123) in let _ = list_of_pairs |> List.hd |> List.iter sprint_key ; diff --git a/fex_js/dune b/fex_js/dune deleted file mode 100644 index 7709a3c..0000000 --- a/fex_js/dune +++ /dev/null @@ -1,6 +0,0 @@ -(executable - (modes js) - (name fex) - (libraries js_of_ocaml fex.compiler brr fex.flattener yojson) - (preprocess - (pps js_of_ocaml-ppx))) diff --git a/fex_js/fex.ml b/fex_js/fex.ml deleted file mode 100644 index 8aa4928..0000000 --- a/fex_js/fex.ml +++ /dev/null @@ -1,29 +0,0 @@ -open Js_of_ocaml - -let a = - Js.export_all - (object%js - (* method flattenArray (obj)= *) - (* let as_yojson = obj |> Jv.to_string |> Yojson.Safe.from_string in *) - (* let as_list = match as_yojson with *) - (* | `List lst -> `List lst *) - (* | _ -> failwith "must be a json array" *) - (* in *) - (* Fex_flattener.pairs_from_json_array as_list *) - - (* method flattenObject (obj:Jv.t) = *) - (* let as_yojson = obj |> Jv.to_string |> Yojson.Safe.from_string in *) - (* Fex_flattener.pair_list_of_json as_yojson *) - - (* method applyListFilter (filter:Jstr.t) pairs = *) - (* let filter' = Fex_compiler.filter_from_string filter in *) - (* match filter' with *) - (* | Ok filters -> Fex_compiler.apply_list_filter filters pairs *) - (* | Error err -> failwith err *) - - (* method applyListOfFiltersForPair (filter:Jstr.t) pairs = *) - (* let filter' = Fex_compiler.filter_from_string filter in *) - (* match filter' with *) - (* | Ok filters -> Fex_compiler.apply_list_filter_for_pairs filters pairs *) - (* | Error err -> failwith err *) - end) diff --git a/fex_js_test/dune b/fex_js_test/dune deleted file mode 100644 index e69de29..0000000 diff --git a/fex_js_test/example.t b/fex_js_test/example.t deleted file mode 100644 index 5cafc66..0000000 --- a/fex_js_test/example.t +++ /dev/null @@ -1,2 +0,0 @@ - $ echo shit - shit From 5dfa4455c0e87754770e01475a5566628639f918 Mon Sep 17 00:00:00 2001 From: Paul Monson Date: Fri, 22 Dec 2023 08:51:22 -0600 Subject: [PATCH 03/12] Staging --- Makefile | 4 +-- bin/dune | 1 - compiler/filter_lexer.mll | 4 +-- compiler/filter_parser.mly | 13 ++++------ dune-project | 5 ---- fex.opam | 4 --- fex.opam.locked | 51 ------------------------------------- flattener/fex_flattener.ml | 2 ++ flattener/fex_flattener.mli | 1 + flattener_test/json_test.ml | 14 ++++++++++ 10 files changed, 26 insertions(+), 73 deletions(-) delete mode 100644 fex.opam.locked diff --git a/Makefile b/Makefile index 2777cde..1d95a42 100644 --- a/Makefile +++ b/Makefile @@ -35,7 +35,7 @@ clean: .PHONY: create-switch create-switch: _opam/.opam-switch/config/ocaml.config - @echo "current switch: $$(opam switch show)" + @echo "current switch: $$(opam switch show) $(RELEASE_NAME)" .PHONY: setup setup: create-switch @@ -52,4 +52,4 @@ deps: create-switch fi; _opam/.opam-switch/config/ocaml.config: - -opam switch create . ${OPAM_SWITCH_VER} --deps-only --yes 2>>/dev/null + -opam switch create . ${OPAM_SWITCH_VER} --deps-only --with-test --locked --yes 2>>/dev/null diff --git a/bin/dune b/bin/dune index 6cac9b4..d98f4cb 100644 --- a/bin/dune +++ b/bin/dune @@ -1,5 +1,4 @@ (executable - (modes js exe) (name fex) (public_name fex) (instrumentation diff --git a/compiler/filter_lexer.mll b/compiler/filter_lexer.mll index f29b5d1..5801a8e 100644 --- a/compiler/filter_lexer.mll +++ b/compiler/filter_lexer.mll @@ -55,7 +55,7 @@ and read_string buf = { Buffer.add_string buf (Lexing.lexeme lexbuf); read_string buf lexbuf } | _ { raise (SyntaxError ("Illegal string character: " ^ Lexing.lexeme lexbuf)) } - | eof { raise (SyntaxError ("String is not terminated")) } + | eof { STRING ("'" ^ Buffer.contents buf) } and read_string2 buf = parse @@ -68,4 +68,4 @@ and read_string2 buf = { Buffer.add_string buf (Lexing.lexeme lexbuf); read_string2 buf lexbuf } | _ { raise (SyntaxError ("Illegal string character: " ^ Lexing.lexeme lexbuf)) } - | eof { raise (SyntaxError ("String is not terminated")) } + | eof { STRING ("\"" ^ Buffer.contents buf) } diff --git a/compiler/filter_parser.mly b/compiler/filter_parser.mly index 3373909..92903c1 100644 --- a/compiler/filter_parser.mly +++ b/compiler/filter_parser.mly @@ -22,8 +22,6 @@ op_result: %inline string_list: | values= separated_nonempty_list(" ", STRING) { values } - | f= FLOAT; values= separated_nonempty_list(" ", STRING) - { (string_of_float f) :: values } %inline q_string_list: | values= separated_nonempty_list(" ", Q_STRING) { values } @@ -40,12 +38,11 @@ standard_term: number: | f= FLOAT { f } -number_value_term: - | "<"; f= number; { Ast.less_than_of_float f } - | ">"; f= number; { Ast.greater_than_of_float f } - | "="; f= number; { Ast.exact_of_float f } - | l= number; " "*; ".."; h= number - { Ast.between_of_float l h } +number_value_term: (* The operator needs to be managed differently and moved into the term clause, it makes me wonder if we want a seperate value lexer clause to deal with this? *) + | "<"; f= number; { Ast.less_than_of_float f } (* should maybe be the Number.t here? *) + | ">"; f= number; { Ast.greater_than_of_float f } + | "="; f= number; { Ast.exact_of_float f } + | l= number; " "*; ".."; h= number { Ast.between_of_float l h } %inline value_term: | " "*; term= standard_term { term } diff --git a/dune-project b/dune-project index 5626c46..e5f1d0c 100644 --- a/dune-project +++ b/dune-project @@ -1,6 +1,5 @@ (lang dune 2.7) (using menhir 2.0) -(explicit_js_mode) (cram enable) (name fex) @@ -22,12 +21,9 @@ (depends (dune (>= 2.5)) (ocaml (>= 4.08)) - (js_of_ocaml-compiler (>= 3.7)) - (js_of_ocaml-ppx (>= 3.7)) (cmdliner (>= 0.9)) (bos (>= 0.2)) - (brr (>= 0.0.1)) (containers (>= 3.2)) (menhir (>= 20200624)) (yojson (>= 1.7.0)) @@ -36,7 +32,6 @@ ;; Testing (alcotest (and :with-test (>= 1.1))) - (merlin :dev) (ocamlformat :dev) (ocp-indent :dev) (ocp-index :dev) diff --git a/fex.opam b/fex.opam index c3092ea..5cb308e 100644 --- a/fex.opam +++ b/fex.opam @@ -12,17 +12,13 @@ bug-reports: "https://github.com/pmonson711/fex/issues" depends: [ "dune" {>= "2.7" & >= "2.5"} "ocaml" {>= "4.08"} - "js_of_ocaml-compiler" {>= "3.7"} - "js_of_ocaml-ppx" {>= "3.7"} "cmdliner" {>= "0.9"} "bos" {>= "0.2"} - "brr" {>= "0.0.1"} "containers" {>= "3.2"} "menhir" {>= "20200624"} "yojson" {>= "1.7.0"} "ppx_deriving" {>= "4.4"} "alcotest" {with-test & >= "1.1"} - "merlin" {dev} "ocamlformat" {dev} "ocp-indent" {dev} "ocp-index" {dev} diff --git a/fex.opam.locked b/fex.opam.locked deleted file mode 100644 index 3440a89..0000000 --- a/fex.opam.locked +++ /dev/null @@ -1,51 +0,0 @@ -opam-version: "2.0" -name: "fex" -version: "unreleased" -synopsis: "Parser generater for fex" -description: "Parser generater for fex" -maintainer: "pmonson711@gmail.com" -authors: "Paul Monson" -license: "MIT" -homepage: "https://github.com/pmonson711/fex/" -doc: "https://github.com/pmonson711/fex/" -bug-reports: "https://github.com/pmonson711/fex/issues" -depends: [ - "alcotest" {with-test & = "1.5.0"} - "bisect_ppx" {= "2.8.0" & dev} - "bos" {= "0.2.1"} - "brr" {= "0.0.3"} - "cmdliner" {= "1.1.0"} - "containers" {= "3.6.1"} - "dune" {= "2.9.3"} - "js_of_ocaml-compiler" {= "4.0.0"} - "js_of_ocaml-ppx" {= "4.0.0"} - "menhir" {= "20220210"} - "merlin" {= "4.4-413" & dev} - "ocaml" {= "4.13.1"} - "ocamlformat" {= "0.20.1" & dev} - "ocp-indent" {= "1.8.1" & dev} - "ocp-index" {= "1.3.3" & dev} - "odig" {= "0.0.8" & dev} - "odoc" {= "2.1.0" & with-doc} - "ppx_deriving" {= "5.2.1"} - "utop" {= "2.9.0" & dev} - "yojson" {= "1.7.0"} -] -build: [ - ["dune" "subst"] {dev} - [ - "dune" - "build" - "-p" - name - "-j" - jobs - "@install" - "@runtest" {with-test} - "@doc" {with-doc} - ] -] -dev-repo: "git+https://github.com/pmonson711/fex/" -url { - src: "git+file:///usr/home/pmonson/src/ocaml/fex#main" -} \ No newline at end of file diff --git a/flattener/fex_flattener.ml b/flattener/fex_flattener.ml index bed2098..79420a9 100644 --- a/flattener/fex_flattener.ml +++ b/flattener/fex_flattener.ml @@ -57,3 +57,5 @@ let pairs_from_json_array (`List lst) = List.map pair_from_json lst let pair_list_of_json = function | `List lst -> pairs_from_json_array (`List lst) |> List.flatten | json -> pair_from_json json + +let pair_to_string_tuple = List.map to_string_tuple diff --git a/flattener/fex_flattener.mli b/flattener/fex_flattener.mli index 5a7ddda..8d297fd 100644 --- a/flattener/fex_flattener.mli +++ b/flattener/fex_flattener.mli @@ -18,3 +18,4 @@ type pairs = Pair.StringPair.t list [@@deriving show, eq] val pair_from_json : JSON.t -> pairs val pairs_from_json_array : [ `List of JSON.t list ] -> pairs list val pair_list_of_json : JSON.t -> pairs +val pair_to_string_tuple : pairs -> (string * string) list diff --git a/flattener_test/json_test.ml b/flattener_test/json_test.ml index b66cfaf..82b2c9c 100644 --- a/flattener_test/json_test.ml +++ b/flattener_test/json_test.ml @@ -66,6 +66,19 @@ let l2_composite () = ] {|[{"a": "b"}, "d", 1, 2.3]|} +let to_string_pairs () = + let open Alcotest in + let make_test input expect = + check + (list (pair string string)) + (Printf.sprintf "%s value" @@ Yojson.Safe.to_string input) + (Fex_flattener.pair_to_string_tuple @@ Fex_flattener.pair_from_json input) + expect + in + make_test + (`Assoc [ ("a", `String "b"); ("b", `Int 1); ("c", `Float 1.1) ]) + [ ("a", "b"); ("b", "1"); ("c", "1.1") ] + let suite = let open Alcotest in ( test_name @@ -73,4 +86,5 @@ let suite = ; test_case "Empty Composite values" `Quick empty_composite ; test_case "Level 1 Composite values" `Quick l1_composite ; test_case "Level 2 Composite values" `Quick l2_composite + ; test_case "String pairs" `Quick to_string_pairs ] ) From d798ee17d58bbcc0b15818d4dd10ed3cf94fc00d Mon Sep 17 00:00:00 2001 From: Paul Monson Date: Fri, 22 Dec 2023 15:12:52 -0600 Subject: [PATCH 04/12] Many small updates --- bin_test/examples.t | 9 +- compiler/ast.ml | 24 +- compiler/ast.mli | 9 +- compiler/combiner.ml | 4 +- compiler/filter_lexer.mll | 6 +- compiler/filter_parser.messages | 810 ++++++++++++++++++++++++----- compiler/filter_parser.mly | 125 ++++- compiler/match_in_order.ml | 2 +- compiler_test/fex_compiler_test.ml | 3 +- compiler_test/messages_test.ml | 81 +-- compiler_test/parser_test.ml | 42 +- 11 files changed, 863 insertions(+), 252 deletions(-) diff --git a/bin_test/examples.t b/bin_test/examples.t index c3efec5..a9dd239 100644 --- a/bin_test/examples.t +++ b/bin_test/examples.t @@ -70,17 +70,17 @@ Finds person under 51 person a|50|1|d| Finds person betwen 49 and 51 - $ fex "age:49..51" data.json + $ fex "age:=49..51" data.json name|age|prop.a|prop.b.c| person a|50|1|d| Finds person betwen 50 and 52 - $ fex "age:50..52" data.json + $ fex "age:=50..52" data.json name|age|prop.a|prop.b.c| person b|51|2|f| Finds person betwen 40 and 60 - $ fex "age:40..60" data.json + $ fex "age:=40..60" data.json name|age|prop.a|prop.b.c| person a|50|1|d| person b|51|2|f| @@ -93,6 +93,3 @@ Finds person with prop.a > 1 Finds person nested c and value exists $ fex ":+" data.json name|age|prop.a|prop.b.c| - Syntax error 5 on line 1, character 2: - - diff --git a/compiler/ast.ml b/compiler/ast.ml index 31cce63..167aa0b 100644 --- a/compiler/ast.ml +++ b/compiler/ast.ml @@ -10,13 +10,18 @@ type 'a match_type = ] module Number = struct - type t = int * float option [@@deriving show, eq, ord] + type t = string * int * float option [@@deriving show, ord] - let of_int i = (i, None) + let equal (_, i1, rf1) (_, i2, rf2) = i1 = i2 && rf1 = rf2 + let of_int i = (string_of_int i, i, None) let of_float f = - if Float.is_integer f then (Float.to_int f, None) - else (Float.to_int f, Some (f -. Float.trunc f)) + if Float.is_integer f then (Float.to_string f, Float.to_int f, None) + else (Float.to_string f, Float.to_int f, Some (f -. Float.trunc f)) + + let of_string s = + let _, i, rf = of_float @@ Float.of_string s in + (String.trim s, i, rf) end type 'a string_match_operation = @@ -32,7 +37,7 @@ type number_match_operation = | ExactNumber of number | LessThanNumber of number | GreaterThanNumber of number - | BetweeNumber of number * number + | BetweenNumber of number * number [@@deriving show, eq] type 'a match_operation = @@ -83,19 +88,26 @@ let is_exclude = function let number_of_int = Number.of_int let number_of_float = Number.of_float +let number_of_string = Number.of_string let number_comp = Number.compare let number_op op = NumberOp op let exact_of_num num = number_op (ExactNumber num) let exact_of_int num = num |> number_of_int |> exact_of_num let exact_of_float num = num |> number_of_float |> exact_of_num +let exact_of_string num = num |> number_of_string |> exact_of_num let less_than num = number_op (LessThanNumber num) let less_than_of_int num = num |> number_of_int |> less_than let less_than_of_float num = num |> number_of_float |> less_than +let less_than_of_string num = num |> number_of_string |> less_than let greater_than num = number_op (GreaterThanNumber num) let greater_than_of_int num = num |> number_of_int |> greater_than let greater_than_of_float num = num |> number_of_float |> greater_than -let between low high = number_op (BetweeNumber (low, high)) +let greater_than_of_string num = num |> number_of_string |> greater_than +let between low high = number_op (BetweenNumber (low, high)) let between_of_int low high = between (number_of_int low) (number_of_int high) let between_of_float low high = between (number_of_float low) (number_of_float high) + +let between_of_string low high = + between (number_of_string low) (number_of_string high) diff --git a/compiler/ast.mli b/compiler/ast.mli index d83f8e5..caa5d69 100644 --- a/compiler/ast.mli +++ b/compiler/ast.mli @@ -15,7 +15,7 @@ type match_operation_result = | Exclude [@@deriving show, eq] -type number = int * float option [@@deriving show, eq, ord] +type number = string * int * float option [@@deriving show, eq, ord] type 'a match_type = [ `String of 'a @@ -35,7 +35,7 @@ type number_match_operation = | ExactNumber of number | LessThanNumber of number | GreaterThanNumber of number - | BetweeNumber of number * number + | BetweenNumber of number * number [@@deriving show, eq] type 'a match_operation = @@ -103,15 +103,19 @@ val contains_value : ?op:match_operation_result -> 'a -> 'a t val exact_of_int : int -> 'a match_operation val exact_of_float : float -> 'a match_operation +val exact_of_string : string -> 'a match_operation val exact_of_num : number -> 'a match_operation val less_than_of_int : int -> 'a match_operation val less_than_of_float : float -> 'a match_operation +val less_than_of_string : string -> 'a match_operation val less_than : number -> 'a match_operation val greater_than_of_int : int -> 'a match_operation val greater_than_of_float : float -> 'a match_operation +val greater_than_of_string : string -> 'a match_operation val greater_than : number -> 'a match_operation val between_of_int : int -> int -> 'a match_operation val between_of_float : float -> float -> 'a match_operation +val between_of_string : string -> string -> 'a match_operation val between : number -> number -> 'a match_operation (** {2 Ast helpers} *) @@ -134,6 +138,7 @@ val is_include : 'a t -> bool val number_of_int : int -> number val number_of_float : float -> number +val number_of_string : string -> number val string_op_of_op : 'a match_operation -> 'a string_match_operation option val number_op_of_op : 'a match_operation -> number_match_operation option val number_comp : number -> number -> int diff --git a/compiler/combiner.ml b/compiler/combiner.ml index f6cae11..599f8aa 100644 --- a/compiler/combiner.ml +++ b/compiler/combiner.ml @@ -51,7 +51,7 @@ let group_as ~equal_fun a b = IncludePairGroupLessThanNumber num | PairFilter (Include, NumberOp (GreaterThanNumber num), _) -> IncludePairGroupGreaterThanNumber num - | PairFilter (Include, NumberOp (BetweeNumber (bottom, top)), _) -> + | PairFilter (Include, NumberOp (BetweenNumber (bottom, top)), _) -> IncludePairGroupBetweenNumber (bottom, top) | PairFilter (Exclude, NumberOp (ExactNumber num), _) -> ExcludePairGroupExactNumber num @@ -59,7 +59,7 @@ let group_as ~equal_fun a b = ExcludePairGroupLessThanNumber num | PairFilter (Exclude, NumberOp (GreaterThanNumber num), _) -> ExcludePairGroupGreaterThanNumber num - | PairFilter (Exclude, NumberOp (BetweeNumber (bottom, top)), _) -> + | PairFilter (Exclude, NumberOp (BetweenNumber (bottom, top)), _) -> ExcludePairGroupBetweenNumber (bottom, top) in let category_a = categorize a in diff --git a/compiler/filter_lexer.mll b/compiler/filter_lexer.mll index 5801a8e..595f3f3 100644 --- a/compiler/filter_lexer.mll +++ b/compiler/filter_lexer.mll @@ -31,11 +31,11 @@ rule read_tokens = | ws '=' { EQUAL } | ws '<' { L_ANGLE } | ws '>' { R_ANGLE } - | '.' '.'+ { DOTDOT } + | ws '.' '.'+ ws { DOTDOT } | ws '-'? digit+ - { FLOAT (Lexing.lexeme lexbuf |> float_of_string) } + { NUMBER (Lexing.lexeme lexbuf) } | ws '-'? digit+ '.' digit+ - { FLOAT (Lexing.lexeme lexbuf |> float_of_string) } + { NUMBER (Lexing.lexeme lexbuf) } | '\'' { read_string (Buffer.create 1) lexbuf } | '"' { read_string2 (Buffer.create 1) lexbuf } | str { STRING (Lexing.lexeme lexbuf |> String.trim) } diff --git a/compiler/filter_parser.messages b/compiler/filter_parser.messages index fd0ba8c..809c915 100644 --- a/compiler/filter_parser.messages +++ b/compiler/filter_parser.messages @@ -1,40 +1,62 @@ -terms: COLON PLUS +terms: SPACE COMMA +## +## Ends in an error in state: 1. +## +## list(SPACE) -> SPACE . list(SPACE) [ STRING R_ANGLE Q_STRING PLUS NUMBER MINUS L_ANGLE EQUAL EOF DOTDOT ] +## +## The known suffix of the stack is as follows: +## SPACE +## + + + +terms: COMMA EOF ## ## Ends in an error in state: 5. ## -## term -> COLON . list(SPACE) standard_term [ EOF COMMA ] +## nonempty_list(COMMA) -> COMMA . [ STRING SPACE R_ANGLE Q_STRING PLUS NUMBER MINUS L_ANGLE EQUAL DOTDOT COLON ] +## nonempty_list(COMMA) -> COMMA . nonempty_list(COMMA) [ STRING SPACE R_ANGLE Q_STRING PLUS NUMBER MINUS L_ANGLE EQUAL DOTDOT COLON ] ## ## The known suffix of the stack is as follows: -## COLON +## COMMA ## -terms: COLON Q_STRING COLON +terms: COLON EOF ## -## Ends in an error in state: 31. +## Ends in an error in state: 7. ## -## separated_nonempty_list(COMMA,term) -> term . [ EOF ] -## separated_nonempty_list(COMMA,term) -> term . COMMA separated_nonempty_list(COMMA,term) [ EOF ] +## nonempty_list(COLON) -> COLON . [ COMMA ] +## nonempty_list(COLON) -> COLON . nonempty_list(COLON) [ COMMA ] +## term -> COLON . list(SPACE) value_standard_term [ EOF COMMA ] +## term -> COLON . list(SPACE) number_value_term [ EOF COMMA ] ## ## The known suffix of the stack is as follows: -## term +## COLON ## -## WARNING: This example involves spurious reductions. -## This implies that, although the LR(1) items shown above provide an -## accurate view of the past (what has been recognized so far), they -## may provide an INCOMPLETE view of the future (what was expected next). -## In state 10, spurious reduction of production standard_term -> Q_STRING -## In state 18, spurious reduction of production term -> COLON list(SPACE) standard_term + + + +terms: COLON COLON STRING +## +## Ends in an error in state: 8. +## +## nonempty_list(COLON) -> COLON . [ COMMA ] +## nonempty_list(COLON) -> COLON . nonempty_list(COLON) [ COMMA ] +## +## The known suffix of the stack is as follows: +## COLON ## -terms: COLON SPACE COMMA +terms: COLON SPACE EOF ## -## Ends in an error in state: 6. +## Ends in an error in state: 10. ## -## term -> COLON list(SPACE) . standard_term [ EOF COMMA ] +## term -> COLON list(SPACE) . value_standard_term [ EOF COMMA ] +## term -> COLON list(SPACE) . number_value_term [ EOF COMMA ] ## ## The known suffix of the stack is as follows: ## COLON list(SPACE) @@ -49,132 +71,500 @@ terms: COLON SPACE COMMA -terms: COMMA STRING +terms: COLON STRING STRING ## -## Ends in an error in state: 49. +## Ends in an error in state: 11. ## -## nonempty_list(COMMA) -> COMMA . [ EOF ] -## nonempty_list(COMMA) -> COMMA . nonempty_list(COMMA) [ EOF ] +## separated_nonempty_list(SPACE,value_string_2) -> STRING . list(COLON) [ EOF DOTDOT COMMA ] +## separated_nonempty_list(SPACE,value_string_2) -> STRING . list(COLON) SPACE separated_nonempty_list(SPACE,value_string_2) [ EOF DOTDOT COMMA ] ## ## The known suffix of the stack is as follows: -## COMMA +## STRING ## -terms: DOTDOT Q_STRING STRING +terms: COLON MINUS COLON STRING ## ## Ends in an error in state: 12. ## -## separated_nonempty_list(SPACE,Q_STRING) -> Q_STRING . [ EOF DOTDOT COMMA COLON ] -## separated_nonempty_list(SPACE,Q_STRING) -> Q_STRING . SPACE separated_nonempty_list(SPACE,Q_STRING) [ EOF DOTDOT COMMA COLON ] +## list(COLON) -> COLON . list(COLON) [ SPACE EOF DOTDOT COMMA ] ## ## The known suffix of the stack is as follows: -## Q_STRING +## COLON ## -terms: DOTDOT SPACE +terms: COLON STRING SPACE SPACE ## -## Ends in an error in state: 14. +## Ends in an error in state: 15. ## -## standard_term -> DOTDOT . separated_nonempty_list(SPACE,STRING) [ EOF COMMA COLON ] -## standard_term -> DOTDOT . separated_nonempty_list(SPACE,Q_STRING) [ EOF COMMA COLON ] -## standard_term -> DOTDOT . separated_nonempty_list(SPACE,Q_STRING) DOTDOT [ EOF COMMA COLON ] +## separated_nonempty_list(SPACE,value_string_2) -> STRING list(COLON) SPACE . separated_nonempty_list(SPACE,value_string_2) [ EOF DOTDOT COMMA ] ## ## The known suffix of the stack is as follows: -## DOTDOT +## STRING list(COLON) SPACE ## -terms: PLUS PLUS +terms: COLON PLUS R_ANGLE ## -## Ends in an error in state: 34. +## Ends in an error in state: 16. ## -## term -> op_result . list(SPACE) standard_term COLON list(SPACE) standard_term [ EOF COMMA ] -## term -> op_result . list(SPACE) standard_term COLON [ EOF COMMA ] -## term -> op_result . list(SPACE) standard_term [ EOF COMMA ] +## nonempty_list(PLUS) -> PLUS . [ STRING SPACE NUMBER MINUS EOF DOTDOT COMMA COLON ] +## nonempty_list(PLUS) -> PLUS . nonempty_list(PLUS) [ STRING SPACE NUMBER MINUS EOF DOTDOT COMMA COLON ] ## ## The known suffix of the stack is as follows: -## op_result +## PLUS ## -terms: PLUS SPACE COMMA +terms: COLON NUMBER R_ANGLE +## +## Ends in an error in state: 18. +## +## separated_nonempty_list(SPACE,value_string_2) -> NUMBER . list(COLON) [ EOF DOTDOT COMMA ] +## separated_nonempty_list(SPACE,value_string_2) -> NUMBER . STRING list(COLON) [ EOF DOTDOT COMMA ] +## separated_nonempty_list(SPACE,value_string_2) -> NUMBER . list(COLON) SPACE separated_nonempty_list(SPACE,value_string_2) [ EOF DOTDOT COMMA ] +## separated_nonempty_list(SPACE,value_string_2) -> NUMBER . STRING list(COLON) SPACE separated_nonempty_list(SPACE,value_string_2) [ EOF DOTDOT COMMA ] +## +## The known suffix of the stack is as follows: +## NUMBER +## + + + +terms: COLON NUMBER STRING STRING +## +## Ends in an error in state: 19. +## +## separated_nonempty_list(SPACE,value_string_2) -> NUMBER STRING . list(COLON) [ EOF DOTDOT COMMA ] +## separated_nonempty_list(SPACE,value_string_2) -> NUMBER STRING . list(COLON) SPACE separated_nonempty_list(SPACE,value_string_2) [ EOF DOTDOT COMMA ] +## +## The known suffix of the stack is as follows: +## NUMBER STRING +## + + + +terms: COLON NUMBER STRING SPACE SPACE +## +## Ends in an error in state: 21. +## +## separated_nonempty_list(SPACE,value_string_2) -> NUMBER STRING list(COLON) SPACE . separated_nonempty_list(SPACE,value_string_2) [ EOF DOTDOT COMMA ] +## +## The known suffix of the stack is as follows: +## NUMBER STRING list(COLON) SPACE +## + + + +terms: COLON MINUS R_ANGLE +## +## Ends in an error in state: 22. +## +## nonempty_list(MINUS) -> MINUS . [ STRING SPACE PLUS NUMBER EOF DOTDOT COMMA COLON ] +## nonempty_list(MINUS) -> MINUS . nonempty_list(MINUS) [ STRING SPACE PLUS NUMBER EOF DOTDOT COMMA COLON ] +## +## The known suffix of the stack is as follows: +## MINUS +## + + + +terms: COLON PLUS STRING STRING +## +## Ends in an error in state: 26. +## +## separated_nonempty_list(SPACE,value_string_2) -> nonempty_list(PLUS) STRING . list(COLON) [ EOF DOTDOT COMMA ] +## separated_nonempty_list(SPACE,value_string_2) -> nonempty_list(PLUS) STRING . list(COLON) SPACE separated_nonempty_list(SPACE,value_string_2) [ EOF DOTDOT COMMA ] +## +## The known suffix of the stack is as follows: +## nonempty_list(PLUS) STRING +## + + + +terms: COLON PLUS STRING SPACE SPACE +## +## Ends in an error in state: 28. +## +## separated_nonempty_list(SPACE,value_string_2) -> nonempty_list(PLUS) STRING list(COLON) SPACE . separated_nonempty_list(SPACE,value_string_2) [ EOF DOTDOT COMMA ] +## +## The known suffix of the stack is as follows: +## nonempty_list(PLUS) STRING list(COLON) SPACE +## + + + +terms: COLON MINUS STRING STRING +## +## Ends in an error in state: 31. +## +## separated_nonempty_list(SPACE,value_string_2) -> nonempty_list(MINUS) STRING . list(COLON) [ EOF DOTDOT COMMA ] +## separated_nonempty_list(SPACE,value_string_2) -> nonempty_list(MINUS) STRING . list(COLON) SPACE separated_nonempty_list(SPACE,value_string_2) [ EOF DOTDOT COMMA ] +## +## The known suffix of the stack is as follows: +## nonempty_list(MINUS) STRING +## + + + +terms: COLON MINUS STRING SPACE SPACE +## +## Ends in an error in state: 33. +## +## separated_nonempty_list(SPACE,value_string_2) -> nonempty_list(MINUS) STRING list(COLON) SPACE . separated_nonempty_list(SPACE,value_string_2) [ EOF DOTDOT COMMA ] +## +## The known suffix of the stack is as follows: +## nonempty_list(MINUS) STRING list(COLON) SPACE +## + + + +terms: COLON MINUS NUMBER R_ANGLE ## ## Ends in an error in state: 35. ## -## term -> op_result list(SPACE) . standard_term COLON list(SPACE) standard_term [ EOF COMMA ] -## term -> op_result list(SPACE) . standard_term COLON [ EOF COMMA ] -## term -> op_result list(SPACE) . standard_term [ EOF COMMA ] +## separated_nonempty_list(SPACE,value_string_2) -> nonempty_list(MINUS) NUMBER . list(COLON) [ EOF DOTDOT COMMA ] +## separated_nonempty_list(SPACE,value_string_2) -> nonempty_list(MINUS) NUMBER . STRING list(COLON) [ EOF DOTDOT COMMA ] +## separated_nonempty_list(SPACE,value_string_2) -> nonempty_list(MINUS) NUMBER . list(COLON) SPACE separated_nonempty_list(SPACE,value_string_2) [ EOF DOTDOT COMMA ] +## separated_nonempty_list(SPACE,value_string_2) -> nonempty_list(MINUS) NUMBER . STRING list(COLON) SPACE separated_nonempty_list(SPACE,value_string_2) [ EOF DOTDOT COMMA ] ## ## The known suffix of the stack is as follows: -## op_result list(SPACE) +## nonempty_list(MINUS) NUMBER +## + + + +terms: COLON MINUS NUMBER STRING STRING +## +## Ends in an error in state: 36. +## +## separated_nonempty_list(SPACE,value_string_2) -> nonempty_list(MINUS) NUMBER STRING . list(COLON) [ EOF DOTDOT COMMA ] +## separated_nonempty_list(SPACE,value_string_2) -> nonempty_list(MINUS) NUMBER STRING . list(COLON) SPACE separated_nonempty_list(SPACE,value_string_2) [ EOF DOTDOT COMMA ] +## +## The known suffix of the stack is as follows: +## nonempty_list(MINUS) NUMBER STRING +## + + + +terms: COLON MINUS NUMBER STRING SPACE SPACE +## +## Ends in an error in state: 38. +## +## separated_nonempty_list(SPACE,value_string_2) -> nonempty_list(MINUS) NUMBER STRING list(COLON) SPACE . separated_nonempty_list(SPACE,value_string_2) [ EOF DOTDOT COMMA ] +## +## The known suffix of the stack is as follows: +## nonempty_list(MINUS) NUMBER STRING list(COLON) SPACE +## + + + +terms: COLON MINUS NUMBER SPACE SPACE +## +## Ends in an error in state: 41. +## +## separated_nonempty_list(SPACE,value_string_2) -> nonempty_list(MINUS) NUMBER list(COLON) SPACE . separated_nonempty_list(SPACE,value_string_2) [ EOF DOTDOT COMMA ] +## +## The known suffix of the stack is as follows: +## nonempty_list(MINUS) NUMBER list(COLON) SPACE +## + + + +terms: COLON MINUS PLUS STRING +## +## Ends in an error in state: 43. +## +## separated_nonempty_list(SPACE,value_string_2) -> nonempty_list(MINUS) nonempty_list(PLUS) . list(COLON) [ EOF DOTDOT COMMA ] +## separated_nonempty_list(SPACE,value_string_2) -> nonempty_list(MINUS) nonempty_list(PLUS) . list(COLON) SPACE separated_nonempty_list(SPACE,value_string_2) [ EOF DOTDOT COMMA ] +## +## The known suffix of the stack is as follows: +## nonempty_list(MINUS) nonempty_list(PLUS) ## ## WARNING: This example involves spurious reductions. ## This implies that, although the LR(1) items shown above provide an ## accurate view of the past (what has been recognized so far), they ## may provide an INCOMPLETE view of the future (what was expected next). -## In state 1, spurious reduction of production list(SPACE) -> -## In state 2, spurious reduction of production list(SPACE) -> SPACE list(SPACE) +## In state 16, spurious reduction of production nonempty_list(PLUS) -> PLUS ## -terms: PLUS STRING COLON PLUS +terms: COLON MINUS PLUS SPACE SPACE ## -## Ends in an error in state: 37. +## Ends in an error in state: 45. ## -## term -> op_result list(SPACE) standard_term COLON . list(SPACE) standard_term [ EOF COMMA ] -## term -> op_result list(SPACE) standard_term COLON . [ EOF COMMA ] +## separated_nonempty_list(SPACE,value_string_2) -> nonempty_list(MINUS) nonempty_list(PLUS) list(COLON) SPACE . separated_nonempty_list(SPACE,value_string_2) [ EOF DOTDOT COMMA ] ## ## The known suffix of the stack is as follows: -## op_result list(SPACE) standard_term COLON +## nonempty_list(MINUS) nonempty_list(PLUS) list(COLON) SPACE ## -terms: PLUS STRING COLON SPACE COMMA +terms: COLON MINUS SPACE SPACE ## -## Ends in an error in state: 38. +## Ends in an error in state: 48. ## -## term -> op_result list(SPACE) standard_term COLON list(SPACE) . standard_term [ EOF COMMA ] +## separated_nonempty_list(SPACE,value_string_2) -> nonempty_list(MINUS) list(COLON) SPACE . separated_nonempty_list(SPACE,value_string_2) [ EOF DOTDOT COMMA ] ## ## The known suffix of the stack is as follows: -## op_result list(SPACE) standard_term COLON list(SPACE) +## nonempty_list(MINUS) list(COLON) SPACE +## + + + +terms: COLON PLUS NUMBER R_ANGLE +## +## Ends in an error in state: 50. +## +## separated_nonempty_list(SPACE,value_string_2) -> nonempty_list(PLUS) NUMBER . list(COLON) [ EOF DOTDOT COMMA ] +## separated_nonempty_list(SPACE,value_string_2) -> nonempty_list(PLUS) NUMBER . STRING list(COLON) [ EOF DOTDOT COMMA ] +## separated_nonempty_list(SPACE,value_string_2) -> nonempty_list(PLUS) NUMBER . list(COLON) SPACE separated_nonempty_list(SPACE,value_string_2) [ EOF DOTDOT COMMA ] +## separated_nonempty_list(SPACE,value_string_2) -> nonempty_list(PLUS) NUMBER . STRING list(COLON) SPACE separated_nonempty_list(SPACE,value_string_2) [ EOF DOTDOT COMMA ] +## +## The known suffix of the stack is as follows: +## nonempty_list(PLUS) NUMBER +## + + + +terms: COLON PLUS NUMBER STRING STRING +## +## Ends in an error in state: 51. +## +## separated_nonempty_list(SPACE,value_string_2) -> nonempty_list(PLUS) NUMBER STRING . list(COLON) [ EOF DOTDOT COMMA ] +## separated_nonempty_list(SPACE,value_string_2) -> nonempty_list(PLUS) NUMBER STRING . list(COLON) SPACE separated_nonempty_list(SPACE,value_string_2) [ EOF DOTDOT COMMA ] +## +## The known suffix of the stack is as follows: +## nonempty_list(PLUS) NUMBER STRING +## + + + +terms: COLON PLUS NUMBER STRING SPACE SPACE +## +## Ends in an error in state: 53. +## +## separated_nonempty_list(SPACE,value_string_2) -> nonempty_list(PLUS) NUMBER STRING list(COLON) SPACE . separated_nonempty_list(SPACE,value_string_2) [ EOF DOTDOT COMMA ] +## +## The known suffix of the stack is as follows: +## nonempty_list(PLUS) NUMBER STRING list(COLON) SPACE +## + + + +terms: COLON PLUS NUMBER SPACE SPACE +## +## Ends in an error in state: 56. +## +## separated_nonempty_list(SPACE,value_string_2) -> nonempty_list(PLUS) NUMBER list(COLON) SPACE . separated_nonempty_list(SPACE,value_string_2) [ EOF DOTDOT COMMA ] +## +## The known suffix of the stack is as follows: +## nonempty_list(PLUS) NUMBER list(COLON) SPACE +## + + + +terms: COLON PLUS MINUS STRING +## +## Ends in an error in state: 58. +## +## separated_nonempty_list(SPACE,value_string_2) -> nonempty_list(PLUS) nonempty_list(MINUS) . list(COLON) [ EOF DOTDOT COMMA ] +## separated_nonempty_list(SPACE,value_string_2) -> nonempty_list(PLUS) nonempty_list(MINUS) . list(COLON) SPACE separated_nonempty_list(SPACE,value_string_2) [ EOF DOTDOT COMMA ] +## +## The known suffix of the stack is as follows: +## nonempty_list(PLUS) nonempty_list(MINUS) ## ## WARNING: This example involves spurious reductions. ## This implies that, although the LR(1) items shown above provide an ## accurate view of the past (what has been recognized so far), they ## may provide an INCOMPLETE view of the future (what was expected next). -## In state 1, spurious reduction of production list(SPACE) -> -## In state 2, spurious reduction of production list(SPACE) -> SPACE list(SPACE) +## In state 22, spurious reduction of production nonempty_list(MINUS) -> MINUS ## -terms: PLUS STRING DOTDOT STRING +terms: COLON PLUS MINUS SPACE SPACE ## -## Ends in an error in state: 36. +## Ends in an error in state: 60. ## -## term -> op_result list(SPACE) standard_term . COLON list(SPACE) standard_term [ EOF COMMA ] -## term -> op_result list(SPACE) standard_term . COLON [ EOF COMMA ] -## term -> op_result list(SPACE) standard_term . [ EOF COMMA ] +## separated_nonempty_list(SPACE,value_string_2) -> nonempty_list(PLUS) nonempty_list(MINUS) list(COLON) SPACE . separated_nonempty_list(SPACE,value_string_2) [ EOF DOTDOT COMMA ] ## ## The known suffix of the stack is as follows: -## op_result list(SPACE) standard_term +## nonempty_list(PLUS) nonempty_list(MINUS) list(COLON) SPACE ## -terms: Q_STRING SPACE Q_STRING EOF +terms: COLON PLUS SPACE SPACE ## -## Ends in an error in state: 21. +## Ends in an error in state: 63. ## -## standard_term -> separated_nonempty_list(SPACE,Q_STRING) . DOTDOT [ EOF COMMA COLON ] +## separated_nonempty_list(SPACE,value_string_2) -> nonempty_list(PLUS) list(COLON) SPACE . separated_nonempty_list(SPACE,value_string_2) [ EOF DOTDOT COMMA ] +## +## The known suffix of the stack is as follows: +## nonempty_list(PLUS) list(COLON) SPACE +## + + + +terms: COLON NUMBER SPACE SPACE +## +## Ends in an error in state: 66. +## +## separated_nonempty_list(SPACE,value_string_2) -> NUMBER list(COLON) SPACE . separated_nonempty_list(SPACE,value_string_2) [ EOF DOTDOT COMMA ] +## +## The known suffix of the stack is as follows: +## NUMBER list(COLON) SPACE +## + + + +terms: COLON R_ANGLE STRING +## +## Ends in an error in state: 69. +## +## number_value_term -> R_ANGLE . number [ EOF COMMA ] +## +## The known suffix of the stack is as follows: +## R_ANGLE +## + + + +terms: COLON Q_STRING STRING +## +## Ends in an error in state: 72. +## +## separated_nonempty_list(SPACE,Q_STRING) -> Q_STRING . [ DOTDOT ] +## separated_nonempty_list(SPACE,Q_STRING) -> Q_STRING . SPACE separated_nonempty_list(SPACE,Q_STRING) [ DOTDOT ] +## value_standard_term -> Q_STRING . [ EOF COMMA ] +## +## The known suffix of the stack is as follows: +## Q_STRING +## + + + +terms: Q_STRING SPACE STRING +## +## Ends in an error in state: 73. +## +## separated_nonempty_list(SPACE,Q_STRING) -> Q_STRING SPACE . separated_nonempty_list(SPACE,Q_STRING) [ EOF DOTDOT COMMA COLON ] +## +## The known suffix of the stack is as follows: +## Q_STRING SPACE +## + + + +terms: DOTDOT Q_STRING STRING +## +## Ends in an error in state: 74. +## +## separated_nonempty_list(SPACE,Q_STRING) -> Q_STRING . [ EOF DOTDOT COMMA COLON ] +## separated_nonempty_list(SPACE,Q_STRING) -> Q_STRING . SPACE separated_nonempty_list(SPACE,Q_STRING) [ EOF DOTDOT COMMA COLON ] +## +## The known suffix of the stack is as follows: +## Q_STRING +## + + + +terms: COLON L_ANGLE STRING +## +## Ends in an error in state: 76. +## +## number_value_term -> L_ANGLE . number [ EOF COMMA ] +## +## The known suffix of the stack is as follows: +## L_ANGLE +## + + + +terms: COLON EQUAL STRING +## +## Ends in an error in state: 78. +## +## number_value_term -> EQUAL . number [ EOF COMMA ] +## number_value_term -> EQUAL . number DOTDOT number [ EOF COMMA ] +## +## The known suffix of the stack is as follows: +## EQUAL +## + + + +terms: COLON EQUAL NUMBER STRING +## +## Ends in an error in state: 79. +## +## number_value_term -> EQUAL number . [ EOF COMMA ] +## number_value_term -> EQUAL number . DOTDOT number [ EOF COMMA ] +## +## The known suffix of the stack is as follows: +## EQUAL number +## + + + +terms: COLON EQUAL NUMBER DOTDOT STRING +## +## Ends in an error in state: 80. +## +## number_value_term -> EQUAL number DOTDOT . number [ EOF COMMA ] +## +## The known suffix of the stack is as follows: +## EQUAL number DOTDOT +## + + + +terms: COLON DOTDOT SPACE +## +## Ends in an error in state: 82. +## +## value_standard_term -> DOTDOT . separated_nonempty_list(SPACE,value_string_2) [ EOF COMMA ] +## value_standard_term -> DOTDOT . separated_nonempty_list(SPACE,Q_STRING) [ EOF COMMA ] +## value_standard_term -> DOTDOT . separated_nonempty_list(SPACE,Q_STRING) DOTDOT [ EOF COMMA ] +## +## The known suffix of the stack is as follows: +## DOTDOT +## + + + +terms: COLON DOTDOT Q_STRING COLON +## +## Ends in an error in state: 84. +## +## value_standard_term -> DOTDOT separated_nonempty_list(SPACE,Q_STRING) . [ EOF COMMA ] +## value_standard_term -> DOTDOT separated_nonempty_list(SPACE,Q_STRING) . DOTDOT [ EOF COMMA ] +## +## The known suffix of the stack is as follows: +## DOTDOT separated_nonempty_list(SPACE,Q_STRING) +## +## WARNING: This example involves spurious reductions. +## This implies that, although the LR(1) items shown above provide an +## accurate view of the past (what has been recognized so far), they +## may provide an INCOMPLETE view of the future (what was expected next). +## In state 74, spurious reduction of production separated_nonempty_list(SPACE,Q_STRING) -> Q_STRING +## + + + +terms: COLON Q_STRING SPACE Q_STRING EOF +## +## Ends in an error in state: 89. +## +## value_standard_term -> separated_nonempty_list(SPACE,Q_STRING) . DOTDOT [ EOF COMMA ] ## ## The known suffix of the stack is as follows: ## separated_nonempty_list(SPACE,Q_STRING) @@ -183,31 +573,130 @@ terms: Q_STRING SPACE Q_STRING EOF ## This implies that, although the LR(1) items shown above provide an ## accurate view of the past (what has been recognized so far), they ## may provide an INCOMPLETE view of the future (what was expected next). -## In state 12, spurious reduction of production separated_nonempty_list(SPACE,Q_STRING) -> Q_STRING -## In state 13, spurious reduction of production separated_nonempty_list(SPACE,Q_STRING) -> Q_STRING SPACE separated_nonempty_list(SPACE,Q_STRING) +## In state 74, spurious reduction of production separated_nonempty_list(SPACE,Q_STRING) -> Q_STRING +## In state 75, spurious reduction of production separated_nonempty_list(SPACE,Q_STRING) -> Q_STRING SPACE separated_nonempty_list(SPACE,Q_STRING) ## -terms: Q_STRING SPACE STRING +terms: EQUAL EOF STRING ## -## Ends in an error in state: 11. +## Ends in an error in state: 92. ## -## separated_nonempty_list(SPACE,Q_STRING) -> Q_STRING SPACE . separated_nonempty_list(SPACE,Q_STRING) [ EOF DOTDOT COMMA COLON ] +## terms -> value_lst . option(SPACE) list(COMMA) EOF [ # ] ## ## The known suffix of the stack is as follows: -## Q_STRING SPACE +## value_lst +## + + + +terms: EQUAL EOF SPACE STRING +## +## Ends in an error in state: 94. +## +## terms -> value_lst option(SPACE) . list(COMMA) EOF [ # ] +## +## The known suffix of the stack is as follows: +## value_lst option(SPACE) +## + + + +terms: EQUAL EOF COMMA STRING +## +## Ends in an error in state: 95. +## +## list(COMMA) -> COMMA . list(COMMA) [ EOF ] +## +## The known suffix of the stack is as follows: +## COMMA +## + + + +terms: COLON L_ANGLE NUMBER STRING +## +## Ends in an error in state: 100. +## +## separated_nonempty_list(COMMA,term) -> term . [ EOF ] +## separated_nonempty_list(COMMA,term) -> term . COMMA separated_nonempty_list(COMMA,term) [ EOF ] +## +## The known suffix of the stack is as follows: +## term +## + + + +terms: EQUAL COMMA EOF +## +## Ends in an error in state: 101. +## +## separated_nonempty_list(COMMA,term) -> term COMMA . separated_nonempty_list(COMMA,term) [ EOF ] +## +## The known suffix of the stack is as follows: +## term COMMA +## + + + +terms: COMMA COLON EOF +## +## Ends in an error in state: 102. +## +## term -> COLON . list(SPACE) value_standard_term [ EOF COMMA ] +## term -> COLON . list(SPACE) number_value_term [ EOF COMMA ] +## +## The known suffix of the stack is as follows: +## COLON +## + + + +terms: MINUS PLUS +## +## Ends in an error in state: 104. +## +## term -> op_result . list(SPACE) key_standard_term COLON list(SPACE) value_standard_term [ EOF COMMA ] +## term -> op_result . list(SPACE) key_standard_term COLON list(SPACE) number_value_term [ EOF COMMA ] +## term -> op_result . list(SPACE) key_standard_term COLON [ EOF COMMA ] +## term -> op_result . list(SPACE) key_standard_term [ EOF COMMA ] +## +## The known suffix of the stack is as follows: +## op_result +## + + + +terms: MINUS SPACE PLUS +## +## Ends in an error in state: 105. +## +## term -> op_result list(SPACE) . key_standard_term COLON list(SPACE) value_standard_term [ EOF COMMA ] +## term -> op_result list(SPACE) . key_standard_term COLON list(SPACE) number_value_term [ EOF COMMA ] +## term -> op_result list(SPACE) . key_standard_term COLON [ EOF COMMA ] +## term -> op_result list(SPACE) . key_standard_term [ EOF COMMA ] +## +## The known suffix of the stack is as follows: +## op_result list(SPACE) +## +## WARNING: This example involves spurious reductions. +## This implies that, although the LR(1) items shown above provide an +## accurate view of the past (what has been recognized so far), they +## may provide an INCOMPLETE view of the future (what was expected next). +## In state 1, spurious reduction of production list(SPACE) -> +## In state 2, spurious reduction of production list(SPACE) -> SPACE list(SPACE) ## terms: Q_STRING STRING ## -## Ends in an error in state: 10. +## Ends in an error in state: 108. ## +## key_standard_term -> Q_STRING . [ EOF COMMA COLON ] ## separated_nonempty_list(SPACE,Q_STRING) -> Q_STRING . [ DOTDOT ] ## separated_nonempty_list(SPACE,Q_STRING) -> Q_STRING . SPACE separated_nonempty_list(SPACE,Q_STRING) [ DOTDOT ] -## standard_term -> Q_STRING . [ EOF COMMA COLON ] ## ## The known suffix of the stack is as follows: ## Q_STRING @@ -215,69 +704,121 @@ terms: Q_STRING STRING -terms: SPACE PLUS +terms: DOTDOT SPACE ## -## Ends in an error in state: 1. +## Ends in an error in state: 112. ## -## list(SPACE) -> SPACE . list(SPACE) [ STRING Q_STRING EOF DOTDOT COMMA ] +## key_standard_term -> DOTDOT . separated_nonempty_list(SPACE,key_value) [ EOF COMMA COLON ] +## key_standard_term -> DOTDOT . separated_nonempty_list(SPACE,Q_STRING) [ EOF COMMA COLON ] +## key_standard_term -> DOTDOT . separated_nonempty_list(SPACE,Q_STRING) DOTDOT [ EOF COMMA COLON ] ## ## The known suffix of the stack is as follows: -## SPACE +## DOTDOT ## -terms: STRING COLON PLUS +terms: EQUAL STRING ## -## Ends in an error in state: 42. +## Ends in an error in state: 116. ## -## term -> list(SPACE) standard_term COLON . list(SPACE) standard_term [ EOF COMMA ] -## term -> list(SPACE) standard_term COLON . [ EOF COMMA ] +## separated_nonempty_list(SPACE,key_value) -> key_value . [ EOF DOTDOT COMMA COLON ] +## separated_nonempty_list(SPACE,key_value) -> key_value . SPACE separated_nonempty_list(SPACE,key_value) [ EOF DOTDOT COMMA COLON ] ## ## The known suffix of the stack is as follows: -## list(SPACE) standard_term COLON +## key_value ## -terms: STRING COLON SPACE COMMA +terms: EQUAL SPACE SPACE ## -## Ends in an error in state: 43. +## Ends in an error in state: 117. +## +## separated_nonempty_list(SPACE,key_value) -> key_value SPACE . separated_nonempty_list(SPACE,key_value) [ EOF DOTDOT COMMA COLON ] +## +## The known suffix of the stack is as follows: +## key_value SPACE +## + + + +terms: Q_STRING SPACE Q_STRING EOF +## +## Ends in an error in state: 121. ## -## term -> list(SPACE) standard_term COLON list(SPACE) . standard_term [ EOF COMMA ] +## key_standard_term -> separated_nonempty_list(SPACE,Q_STRING) . DOTDOT [ EOF COMMA COLON ] ## ## The known suffix of the stack is as follows: -## list(SPACE) standard_term COLON list(SPACE) +## separated_nonempty_list(SPACE,Q_STRING) ## ## WARNING: This example involves spurious reductions. ## This implies that, although the LR(1) items shown above provide an ## accurate view of the past (what has been recognized so far), they ## may provide an INCOMPLETE view of the future (what was expected next). -## In state 1, spurious reduction of production list(SPACE) -> -## In state 2, spurious reduction of production list(SPACE) -> SPACE list(SPACE) +## In state 74, spurious reduction of production separated_nonempty_list(SPACE,Q_STRING) -> Q_STRING +## In state 75, spurious reduction of production separated_nonempty_list(SPACE,Q_STRING) -> Q_STRING SPACE separated_nonempty_list(SPACE,Q_STRING) ## -terms: STRING COMMA EOF +terms: MINUS Q_STRING DOTDOT DOTDOT ## -## Ends in an error in state: 32. +## Ends in an error in state: 123. ## -## separated_nonempty_list(COMMA,term) -> term COMMA . separated_nonempty_list(COMMA,term) [ EOF ] +## term -> op_result list(SPACE) key_standard_term . COLON list(SPACE) value_standard_term [ EOF COMMA ] +## term -> op_result list(SPACE) key_standard_term . COLON list(SPACE) number_value_term [ EOF COMMA ] +## term -> op_result list(SPACE) key_standard_term . COLON [ EOF COMMA ] +## term -> op_result list(SPACE) key_standard_term . [ EOF COMMA ] ## ## The known suffix of the stack is as follows: -## term COMMA +## op_result list(SPACE) key_standard_term +## + + + +terms: MINUS EQUAL COLON COLON +## +## Ends in an error in state: 124. +## +## term -> op_result list(SPACE) key_standard_term COLON . list(SPACE) value_standard_term [ EOF COMMA ] +## term -> op_result list(SPACE) key_standard_term COLON . list(SPACE) number_value_term [ EOF COMMA ] +## term -> op_result list(SPACE) key_standard_term COLON . [ EOF COMMA ] +## +## The known suffix of the stack is as follows: +## op_result list(SPACE) key_standard_term COLON ## -terms: STRING COMMA SPACE COMMA +terms: MINUS EQUAL COLON SPACE EOF ## -## Ends in an error in state: 40. +## Ends in an error in state: 125. ## -## term -> list(SPACE) . standard_term COLON list(SPACE) standard_term [ EOF COMMA ] -## term -> list(SPACE) . standard_term COLON [ EOF COMMA ] -## term -> list(SPACE) . standard_term [ EOF COMMA ] +## term -> op_result list(SPACE) key_standard_term COLON list(SPACE) . value_standard_term [ EOF COMMA ] +## term -> op_result list(SPACE) key_standard_term COLON list(SPACE) . number_value_term [ EOF COMMA ] +## +## The known suffix of the stack is as follows: +## op_result list(SPACE) key_standard_term COLON list(SPACE) +## +## WARNING: This example involves spurious reductions. +## This implies that, although the LR(1) items shown above provide an +## accurate view of the past (what has been recognized so far), they +## may provide an INCOMPLETE view of the future (what was expected next). +## In state 1, spurious reduction of production list(SPACE) -> +## In state 2, spurious reduction of production list(SPACE) -> SPACE list(SPACE) +## + + + +terms: COMMA SPACE PLUS +## +## Ends in an error in state: 128. +## +## term -> list(SPACE) . key_standard_term COLON list(SPACE) value_standard_term [ EOF COMMA ] +## term -> list(SPACE) . key_standard_term COLON list(SPACE) number_value_term [ EOF COMMA ] +## term -> list(SPACE) . key_standard_term COLON [ EOF COMMA ] +## term -> list(SPACE) . key_standard_term [ EOF COMMA ] ## ## The known suffix of the stack is as follows: ## list(SPACE) @@ -292,77 +833,98 @@ terms: STRING COMMA SPACE COMMA -terms: STRING DOTDOT STRING +terms: Q_STRING DOTDOT DOTDOT ## -## Ends in an error in state: 41. +## Ends in an error in state: 129. ## -## term -> list(SPACE) standard_term . COLON list(SPACE) standard_term [ EOF COMMA ] -## term -> list(SPACE) standard_term . COLON [ EOF COMMA ] -## term -> list(SPACE) standard_term . [ EOF COMMA ] +## term -> list(SPACE) key_standard_term . COLON list(SPACE) value_standard_term [ EOF COMMA ] +## term -> list(SPACE) key_standard_term . COLON list(SPACE) number_value_term [ EOF COMMA ] +## term -> list(SPACE) key_standard_term . COLON [ EOF COMMA ] +## term -> list(SPACE) key_standard_term . [ EOF COMMA ] ## ## The known suffix of the stack is as follows: -## list(SPACE) standard_term +## list(SPACE) key_standard_term ## -terms: STRING EOF COMMA STRING +terms: EQUAL COLON COLON ## -## Ends in an error in state: 26. +## Ends in an error in state: 130. ## -## list(COMMA) -> COMMA . list(COMMA) [ EOF ] +## term -> list(SPACE) key_standard_term COLON . list(SPACE) value_standard_term [ EOF COMMA ] +## term -> list(SPACE) key_standard_term COLON . list(SPACE) number_value_term [ EOF COMMA ] +## term -> list(SPACE) key_standard_term COLON . [ EOF COMMA ] ## ## The known suffix of the stack is as follows: -## COMMA +## list(SPACE) key_standard_term COLON ## -terms: STRING EOF SPACE COLON +terms: EQUAL COLON SPACE EOF ## -## Ends in an error in state: 25. +## Ends in an error in state: 131. ## -## terms -> value_lst option(SPACE) . list(COMMA) EOF [ # ] +## term -> list(SPACE) key_standard_term COLON list(SPACE) . value_standard_term [ EOF COMMA ] +## term -> list(SPACE) key_standard_term COLON list(SPACE) . number_value_term [ EOF COMMA ] ## ## The known suffix of the stack is as follows: -## value_lst option(SPACE) +## list(SPACE) key_standard_term COLON list(SPACE) +## +## WARNING: This example involves spurious reductions. +## This implies that, although the LR(1) items shown above provide an +## accurate view of the past (what has been recognized so far), they +## may provide an INCOMPLETE view of the future (what was expected next). +## In state 1, spurious reduction of production list(SPACE) -> +## In state 2, spurious reduction of production list(SPACE) -> SPACE list(SPACE) ## -terms: STRING EOF STRING +terms: COMMA EQUAL EOF STRING ## -## Ends in an error in state: 23. +## Ends in an error in state: 137. ## -## terms -> value_lst . option(SPACE) list(COMMA) EOF [ # ] +## terms -> nonempty_list(COMMA) value_lst . EOF [ # ] ## ## The known suffix of the stack is as follows: -## value_lst +## nonempty_list(COMMA) value_lst ## -terms: STRING SPACE SPACE +terms: COLON COMMA EQUAL EOF STRING ## -## Ends in an error in state: 8. +## Ends in an error in state: 141. ## -## separated_nonempty_list(SPACE,STRING) -> STRING SPACE . separated_nonempty_list(SPACE,STRING) [ EOF DOTDOT COMMA COLON ] +## terms -> nonempty_list(COLON) nonempty_list(COMMA) value_lst . EOF [ # ] ## ## The known suffix of the stack is as follows: -## STRING SPACE +## nonempty_list(COLON) nonempty_list(COMMA) value_lst ## -terms: STRING STRING +terms: SPACE PLUS ## -## Ends in an error in state: 7. +## Ends in an error in state: 143. ## -## separated_nonempty_list(SPACE,STRING) -> STRING . [ EOF DOTDOT COMMA COLON ] -## separated_nonempty_list(SPACE,STRING) -> STRING . SPACE separated_nonempty_list(SPACE,STRING) [ EOF DOTDOT COMMA COLON ] +## term -> list(SPACE) . key_standard_term COLON list(SPACE) value_standard_term [ EOF COMMA ] +## term -> list(SPACE) . key_standard_term COLON list(SPACE) number_value_term [ EOF COMMA ] +## term -> list(SPACE) . key_standard_term COLON [ EOF COMMA ] +## term -> list(SPACE) . key_standard_term [ EOF COMMA ] +## terms -> list(SPACE) . EOF [ # ] ## ## The known suffix of the stack is as follows: -## STRING +## list(SPACE) +## +## WARNING: This example involves spurious reductions. +## This implies that, although the LR(1) items shown above provide an +## accurate view of the past (what has been recognized so far), they +## may provide an INCOMPLETE view of the future (what was expected next). +## In state 1, spurious reduction of production list(SPACE) -> +## In state 2, spurious reduction of production list(SPACE) -> SPACE list(SPACE) ## diff --git a/compiler/filter_parser.mly b/compiler/filter_parser.mly index 92903c1..9c5d2db 100644 --- a/compiler/filter_parser.mly +++ b/compiler/filter_parser.mly @@ -1,6 +1,6 @@ %token STRING %token Q_STRING -%token FLOAT +%token NUMBER %token COLON ":" %token COMMA "," %token DOTDOT ".." @@ -19,55 +19,138 @@ op_result: | "-"; { Ast.Exclude } | "+"; { Ast.Include } -%inline string_list: - | values= separated_nonempty_list(" ", STRING) - { values } - %inline q_string_list: | values= separated_nonempty_list(" ", Q_STRING) { values } -standard_term: - | ".."; values= string_list { Ast.ends_with_in_order values } - | values= string_list; ".." { Ast.begins_with_in_order values } - | values= string_list { Ast.contains_in_order values } +key_value: + | value= STRING { value } + | value= NUMBER { String.trim value } + | R_ANGLE { ">" } + | L_ANGLE { "<" } + | EQUAL { "=" } +%inline key_string_list: + | values= separated_nonempty_list(" ", key_value) + { values } +key_standard_term: + | ".."; values= key_string_list { Ast.ends_with_in_order values } + | values= key_string_list; ".." { Ast.begins_with_in_order values } + | values= key_string_list { Ast.contains_in_order values } + | ".." { Ast.contains_in_order [".."] } | ".."; values= q_string_list { Ast.ends_with_in_order values } | ".."; values= q_string_list; ".." { Ast.contains_in_order values } | values= q_string_list; ".." { Ast.begins_with_in_order values } | value= Q_STRING; { Ast.exact value } number: - | f= FLOAT { f } + | f= NUMBER { f } + +number_value_term: + | "<"; f= number; { Ast.less_than_of_string f } + | ">"; f= number; { Ast.greater_than_of_string f } + | "="; f= number; { Ast.exact_of_string f } + | "="; l= number; ".."; h= number + { Ast.between_of_string l h } + +%inline value_string_string: + | value= STRING { value } + | value= NUMBER { String.trim value } + | v1= NUMBER; "+"; v2= NUMBER { let b = Buffer.create 16 in + Buffer.add_string b (String.trim v1) ; + Buffer.add_char b '+' ; + Buffer.add_string b (String.trim v2) ; + Buffer.contents b + } + | v1= NUMBER; v2= STRING { let b = Buffer.create 16 in + Buffer.add_string b (String.trim v1) ; + Buffer.add_string b v2 ; + Buffer.contents b + } + +%inline value_string: + | value= value_string_string { value } + | lst= "-"+ + { let b = Buffer.create (List.length lst) in + List.iter (fun () -> Buffer.add_char b '-') lst ; + Buffer.contents b + } + | lst1= "-"+; lst2= "+"+ + { let b = Buffer.create ((List.length lst1) + (List.length lst2)) in + List.iter (fun () -> Buffer.add_char b '-') lst1 ; + List.iter (fun () -> Buffer.add_char b '+') lst2 ; + Buffer.contents b + } + | lst= "-"+; value= value_string_string + { let b = Buffer.create (List.length lst) in + List.iter (fun () -> Buffer.add_char b '-') lst ; + Buffer.add_string b value ; + Buffer.contents b + } + | lst= "+"+; value= value_string_string + { let b = Buffer.create (List.length lst) in + List.iter (fun () -> Buffer.add_char b '+') lst ; + Buffer.add_string b value ; + Buffer.contents b + } + | lst= "+"+ + { let b = Buffer.create (List.length lst) in + List.iter (fun () -> Buffer.add_char b '+') lst ; + Buffer.contents b + } + | lst1= "+"+; lst2= "-"+ + { let b = Buffer.create ((List.length lst1) + (List.length lst2)) in + List.iter (fun () -> Buffer.add_char b '+') lst1 ; + List.iter (fun () -> Buffer.add_char b '-') lst2 ; + Buffer.contents b + } + +%inline value_string_2: + | value= value_string; lst= ":"* + { let b = Buffer.create (List.length lst) in + Buffer.add_string b value ; + List.iter (fun () -> Buffer.add_char b ':') lst ; + Buffer.contents b + } + +%inline value_string_list: + | values= separated_nonempty_list(" ", value_string_2) + { values } + +value_standard_term: + | ".."; values= value_string_list { Ast.ends_with_in_order values } + | values= value_string_list; ".." { Ast.begins_with_in_order values } + | values= value_string_list { Ast.contains_in_order values } + | ".." { Ast.contains_in_order [".."] } + | ".."; values= q_string_list { Ast.ends_with_in_order values } + | ".."; values= q_string_list; ".." { Ast.contains_in_order values } + | values= q_string_list; ".." { Ast.begins_with_in_order values } + | value= Q_STRING; { Ast.exact value } -number_value_term: (* The operator needs to be managed differently and moved into the term clause, it makes me wonder if we want a seperate value lexer clause to deal with this? *) - | "<"; f= number; { Ast.less_than_of_float f } (* should maybe be the Number.t here? *) - | ">"; f= number; { Ast.greater_than_of_float f } - | "="; f= number; { Ast.exact_of_float f } - | l= number; " "*; ".."; h= number { Ast.between_of_float l h } %inline value_term: - | " "*; term= standard_term { term } + | " "*; term= value_standard_term { term } | " "*; term= number_value_term { term } %inline key_term: - | " "*; term= standard_term { term } + | " "*; term= key_standard_term { term } term: | result= op_result; key= key_term; ":"; value= value_term { Ast.pair_filter result key value } | result= op_result; key= key_term; ":" { Ast.key_filter result key } - | result= op_result; value= value_term + | result= op_result; value= key_term { Ast.value_filter result value } | key= key_term; ":"; value= value_term { Ast.pair_filter Ast.inc key value } | key= key_term; ":" { Ast.key_filter Ast.inc key } | ":"; value= value_term { Ast.value_filter Ast.inc value } - | value= value_term { Ast.value_filter Ast.inc value } + | value= key_term { Ast.value_filter Ast.inc value } value_lst: | lst= separated_nonempty_list(",", term); EOF { lst } terms: - | " "*; EOF { [] } - | " "*; ","+; EOF { [] } + | " "*; EOF; { [] } + | ","+; lst= value_lst; EOF { lst } + | ":"+; ","+; lst= value_lst; EOF { lst } | lst= value_lst; " "?; ","*; EOF { lst } diff --git a/compiler/match_in_order.ml b/compiler/match_in_order.ml index f323633..6ffe6cf 100644 --- a/compiler/match_in_order.ml +++ b/compiler/match_in_order.ml @@ -57,7 +57,7 @@ let number_match_operation (from_input : Ast.number) | ExactNumber expected -> Ast.number_comp from_input expected == 0 | Ast.LessThanNumber lower -> Ast.number_comp lower from_input == 1 | Ast.GreaterThanNumber upper -> Ast.number_comp from_input upper == 1 - | Ast.BetweeNumber (lower, upper) -> + | Ast.BetweenNumber (lower, upper) -> Ast.number_comp from_input upper == -1 && Ast.number_comp lower from_input == -1 diff --git a/compiler_test/fex_compiler_test.ml b/compiler_test/fex_compiler_test.ml index 3769a93..8f40ddb 100644 --- a/compiler_test/fex_compiler_test.ml +++ b/compiler_test/fex_compiler_test.ml @@ -1,7 +1,8 @@ let suites = [ Parser_test.suite ; Predicate_test.suite - ; Combiner_test.suite (* ; Messages_test.suite *) + ; Combiner_test.suite + ; Messages_test.suite ] let () = diff --git a/compiler_test/messages_test.ml b/compiler_test/messages_test.ml index 5b2ca87..d0bc27c 100644 --- a/compiler_test/messages_test.ml +++ b/compiler_test/messages_test.ml @@ -2,7 +2,11 @@ let test_name = "Parser Messages" let fex = let open Alcotest in - Fex_compiler.Ast.(testable pp equal) + let string_pp = Fex_compiler.Ast.pp Fex_compiler__Match_in_order.T.pp in + let string_equal = + Fex_compiler.Ast.equal Fex_compiler__Match_in_order.T.equal + in + testable string_pp string_equal let parse = Fex_compiler.filter_from_string @@ -17,85 +21,14 @@ let parse_single_test case_name expected to_parse = check string case_name expected (Result.get_error (parse to_parse) |> scanned)) -let colon_plus () = - let msg = - "The `+` (plus) operator can not directly follow a `:` (colon) operator." - in - parse_single_test "COLON PLUS" msg ":+" ; - parse_single_test "COLON" msg (* TODO why is this being hit here? *) ":" - -let colon_qstring_colon () = - let msg = "The `:` (colon) can only be included once in each query term." in - parse_single_test "COLON Q_STRING COLON" msg ":'':" ; - parse_single_test "COLON Q_STRING COLON" msg {|:"":|} - -let colon_space_comma () = - let msg = - "The `+` (plus) operator can not directly follow a `:` (colon) operator." - in - parse_single_test "COLON SPACE COMMA" msg ": ," - -let colon_string () = - let msg = - "A `,` (comma) followed by a string seems to be missing a filiter before \ - the `,`" - in - parse_single_test "COLON STRING" msg ",somestring" - let base_cases = let state_msg = - [ ( "COLON PLUS" - , {|`+` (plus) in only valid before a term. -here the (plus) is used directly after a `:` (colon) -did you mean `+:` instead of `:+`?|} - ) - ; ( "COLON Q_STRING COLON" + [ ( "COLON Q_STRING COLON" , {|`:` (colon) in only valid between a key term and value term. Here the `:` both begins and ends the filter which is ambiguous. -did you forget a `,` (comma) or add an extra `:`?|} - ) - ; ( "COLON SPACE COMMA" - , {|`:` (colon) alone is not a valid filter term. -Here `:` has no key or value term before a `,` (comma) -Did you forget to add a key or value term?|} - ) - ; ( "COMMA STRING" - , {|`,` (comma) is only valid as a term separator. -Here `,` seems to a beginning empty filter. -did you mean to have the beginning `,`?|} - ) - ; ( "COMMA SPACE STRING" - , {|`,` (comma) is only valid as a term separator. -Here `,` seems to a beginning empty filter. -did you mean to have the beginning `,`?|} +Did you forget a `,` (comma) or add an extra `:`?|} ) ; ("DOTDOT Q_STRING STRING", "") - ; ( "DOTDOT SPACE" - , {|`..` (dot dot) must be followed by a string. -Here `..` is followed by a ` ` (space). -Did you mean to have a string directly before or after the `..`?|} - ) - ; ("MINUS SPACE", "") - ; ("MINUS STRING COLON PLUS", "") - ; ("MINUS STRING COLON SPACE PLUS", "") - ; ("MINUS STRING DOTDOT STRING", "") - ; ("PLUS SPACE", "") - ; ("PLUS STRING COLON PLUS", "") - ; ("PLUS STRING COLON SPACE PLUS", "") - ; ("PLUS STRING DOTDOT STRING", "") - ; ("Q_STRING SPACE Q_STRING EOF", "") - ; ("Q_STRING SPACE STRING", "") - ; ("Q_STRING STRING", "") - ; ("SPACE COLON", "") - (* ; ("SPACE STRING", "") *) - ; ("STRING COLON PLUS", "") - ; ("STRING COLON SPACE PLUS", "") - ; ("STRING COMMA EOF", "") - (* ; ("STRING COMMA SPACE EOF", "") *) - ; ("STRING DOTDOT STRING", "") - (* ; ("STRING EOF STRING", "") *) - (* ; ("STRING SPACE SPACE", "") *) - (* ; ("STRING STRING", "") *) ] in let to_char = function diff --git a/compiler_test/parser_test.ml b/compiler_test/parser_test.ml index 0410a19..15785cd 100644 --- a/compiler_test/parser_test.ml +++ b/compiler_test/parser_test.ml @@ -44,7 +44,9 @@ let value_only () = make_test "leadingspace" "+ leadingspace" ; make_test "leadingspace" " +leadingspace" ; make_test "trailingspace" "trailingspace " ; - make_test "trailingspace" "+trailingspace " + make_test "trailingspace" "+trailingspace " ; + make_test "5" " 5" ; + make_test "-5" " -5" let value_only_exclude () = let open Fex_compiler.Ast in @@ -60,7 +62,9 @@ let value_only_exclude () = make_test "surround" " -surround " ; make_test "leadingspace" "- leadingspace" ; make_test "leadingspace" " -leadingspace" ; - make_test "trailingspace" "-trailingspace " + make_test "trailingspace" "-trailingspace " ; + make_test "5" "- 5 " ; + make_test "-5" "--5 " let key_only () = let open Fex_compiler.Ast in @@ -78,7 +82,9 @@ let key_only () = make_test "surround" " +surround :" ; make_test "leadingspace" "+ leadingspace:" ; make_test "leadingspace" " +leadingspace:" ; - make_test "trailingspace" "+trailingspace :" + make_test "trailingspace" "+trailingspace :" ; + make_test "5" "5 :" ; + make_test "-5" "-5 :" let key_only_exclude () = let open Fex_compiler.Ast in @@ -93,7 +99,10 @@ let key_only_exclude () = make_test "surround" " -surround :" ; make_test "leadingspace" "- leadingspace:" ; make_test "leadingspace" " -leadingspace:" ; - make_test "trailingspace" "-trailingspace :" + make_test "trailingspace" "-trailingspace :" ; + make_test "5" "- 5:" ; + make_test "-5" "--5:" ; + make_test "-5" "- -5:" let key_value () = let open Fex_compiler.Ast in @@ -118,7 +127,15 @@ let key_value () = make_test ("trailingspace", "value") "+trailingspace :value" ; make_test ("key", "surround") "+key: surround " ; make_test ("key", "leadingspace") "+key: leadingspace" ; - make_test ("key", "trailingspace") "+key:trailingspace " + make_test ("key", "trailingspace") "+key:trailingspace " ; + make_test ("key", "-leadingminus") "key:-leadingminus" ; + make_test ("key", "--leadingminus") "key:--leadingminus" ; + make_test ("key", "trailingminus-") "key:trailingminus-" ; + make_test ("key", "trailingminus--") "key:trailingminus--" ; + make_test ("key", "+leadingplus") "key:+leadingplus" ; + make_test ("key", "++leadingplus") "key:++leadingplus" ; + make_test ("key", "trailingplus+") "key:trailingplus+" ; + make_test ("key", "trailingplus++") "key:trailingplus++" let key_value_exclude () = let open Fex_compiler.Ast in @@ -236,9 +253,10 @@ let int_value_number_betwween_test () = (value_filter inc @@ op expected1 expected2) input in - make_test between_of_int 1 10 ":1..10" ; - make_test between_of_int (-1) 10 ":-1..10" ; - make_test between_of_int (-1) (-10) ":-1..-10" + make_test between_of_int 1 10 ":= 1..10" ; + make_test between_of_int (-1) 10 ":= -1..10" ; + make_test between_of_int (-1) (-10) ":= -1..-10" ; + make_test between_of_int 1 (-10) ":= 1..-10" let float_value_number_betwween_test () = let open Fex_compiler.Ast in @@ -249,9 +267,9 @@ let float_value_number_betwween_test () = (value_filter inc @@ op expected1 expected2) input in - make_test between_of_float 1. 10.01 ":1..10.01" ; - make_test between_of_float (-1.01) 10. ":-1.01..10" ; - make_test between_of_float (-1.01) (-10.01) ":-1.01..-10.01" + make_test between_of_float 1. 10.01 ":= 1..10.01" ; + make_test between_of_float (-1.01) 10. ":= -1.01..10" ; + make_test between_of_float (-1.01) (-10.01) ":= -1.01..-10.01" let float_value_number_test () = let open Fex_compiler.Ast in @@ -287,7 +305,7 @@ let suite = ; test_case "Key Only" `Quick key_only ; test_case "Key Only Exclude" `Quick key_only_exclude ; test_case "Key Value" `Quick key_value - ; test_case "Key Value Exclude" `Quick key_only_exclude + ; test_case "Key Value Exclude" `Quick key_value_exclude ; test_case "Splits" `Quick combinatorials ; test_case "Begins with" `Quick value_only_begins_with ; test_case "Ends with" `Quick value_only_ends_with From 453412d6d3e5d4099636c6597ed4f2629d2af148 Mon Sep 17 00:00:00 2001 From: Paul Monson Date: Sun, 24 Dec 2023 07:57:42 -0600 Subject: [PATCH 05/12] Ensure the std lib types in mli --- compiler/ast.mli | 14 ++++++++------ compiler/fex_compiler.mli | 25 +++++++++++++++++++++---- compiler/match_in_order.mli | 13 +++++++++++++ 3 files changed, 42 insertions(+), 10 deletions(-) create mode 100644 compiler/match_in_order.mli diff --git a/compiler/ast.mli b/compiler/ast.mli index caa5d69..489e309 100644 --- a/compiler/ast.mli +++ b/compiler/ast.mli @@ -13,9 +13,11 @@ type match_operation_result = | Include | Exclude -[@@deriving show, eq] -type number = string * int * float option [@@deriving show, eq, ord] +type number = string * int * float option + +val equal_number : number -> number -> bool +val compare_number : number -> number -> int type 'a match_type = [ `String of 'a @@ -29,19 +31,16 @@ type 'a string_match_operation = | ContainsString of 'a list | BeginsWithString of 'a list | EndsWithString of 'a list -[@@deriving show, eq] type number_match_operation = | ExactNumber of number | LessThanNumber of number | GreaterThanNumber of number | BetweenNumber of number * number -[@@deriving show, eq] type 'a match_operation = | StringOp of 'a string_match_operation | NumberOp of number_match_operation -[@@deriving show, eq] (** The full AST including opterations and include vs exclude result *) type 'a t = @@ -49,7 +48,10 @@ type 'a t = | KeyFilter of match_operation_result * 'a match_operation | PairFilter of match_operation_result * 'a match_operation * 'a match_operation -[@@deriving show, eq] + +val pp : (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a t -> unit +val show : (Format.formatter -> 'a -> unit) -> 'a t -> string +val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool (** {1 Helpers } diff --git a/compiler/fex_compiler.mli b/compiler/fex_compiler.mli index ee392aa..f700fff 100644 --- a/compiler/fex_compiler.mli +++ b/compiler/fex_compiler.mli @@ -1,8 +1,14 @@ module Ast = Ast +module Predicate = Predicate +module Matcher = Match_in_order +module Combiner = Combiner -type parsed_result = (string Ast.t list, string) result [@@deriving show] +type parsed_result = (string Ast.t list, string) result (** A result from parsing a fex query. *) +val pp_parsed_result : Format.formatter -> parsed_result -> unit +val show_parsed_result : parsed_result -> string + exception Grammar_error of string (** Grammer errors are errors that lex correctly but include no valid [!Ast] *) @@ -15,12 +21,23 @@ val filter_from_file : string -> parsed_result val pair_of_strings : string -> string -> string Predicate.pair (** constructor for a pair of strings, useful to convert a source before appling a filter. *) -val apply_filter : string Ast.t -> string Predicate.pair -> bool +val apply_filter : + ?match_fun:(string Ast.match_type -> string Ast.match_operation -> bool) + -> string Ast.t + -> string Predicate.pair + -> bool (** Does the filtering work on the pair, one filter and one pair. *) -val apply_list_filter : string Ast.t list -> string Predicate.pair -> bool +val apply_list_filter : + ?match_fun:(string Ast.match_type -> string Ast.match_operation -> bool) + -> string Ast.t list + -> string Predicate.pair + -> bool (** Does the filtering of a group of filters on a single pair. *) val apply_list_filter_for_pairs : - string Ast.t list -> string Predicate.pair list -> bool + ?match_fun:(string Ast.match_type -> string Ast.match_operation -> bool) + -> string Ast.t list + -> string Predicate.pair list + -> bool (** Does the filtering of a group of filters on a list of pairs. *) diff --git a/compiler/match_in_order.mli b/compiler/match_in_order.mli new file mode 100644 index 0000000..fa7d71d --- /dev/null +++ b/compiler/match_in_order.mli @@ -0,0 +1,13 @@ +val match_operation : + string Ast.match_type -> string Ast.match_operation -> bool + +val string_match_operation : string -> string Ast.string_match_operation -> bool +val number_match_operation : Ast.number -> Ast.number_match_operation -> bool + +module T : sig + type t = string + + val pp : Format.formatter -> t -> unit + val show : t -> string + val equal : t -> t -> bool +end From 734518e48ee2a4f1f215b5d10d381f9fa8d587a7 Mon Sep 17 00:00:00 2001 From: Paul Monson Date: Sun, 24 Dec 2023 08:00:21 -0600 Subject: [PATCH 06/12] Drop message tests for now --- compiler_test/messages_test.ml | 10 +--------- 1 file changed, 1 insertion(+), 9 deletions(-) diff --git a/compiler_test/messages_test.ml b/compiler_test/messages_test.ml index d0bc27c..d013dee 100644 --- a/compiler_test/messages_test.ml +++ b/compiler_test/messages_test.ml @@ -22,15 +22,7 @@ let parse_single_test case_name expected to_parse = (Result.get_error (parse to_parse) |> scanned)) let base_cases = - let state_msg = - [ ( "COLON Q_STRING COLON" - , {|`:` (colon) in only valid between a key term and value term. -Here the `:` both begins and ends the filter which is ambiguous. -Did you forget a `,` (comma) or add an extra `:`?|} - ) - ; ("DOTDOT Q_STRING STRING", "") - ] - in + let state_msg = [] in let to_char = function | "MINUS" -> "-" | "PLUS" -> "+" From 3b974b097a9bac737e4a706e7baada47cce43c4b Mon Sep 17 00:00:00 2001 From: Paul Monson Date: Sun, 24 Dec 2023 08:03:14 -0600 Subject: [PATCH 07/12] Allow match_fun in compiler api --- compiler/fex_compiler.ml | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/compiler/fex_compiler.ml b/compiler/fex_compiler.ml index bcdb362..fe71c37 100644 --- a/compiler/fex_compiler.ml +++ b/compiler/fex_compiler.ml @@ -1,6 +1,9 @@ open Lexing module I = Filter_parser.MenhirInterpreter module Ast = Ast +module Predicate = Predicate +module Matcher = Match_in_order +module Combiner = Combiner exception Grammar_error of string @@ -63,13 +66,12 @@ let filter_from_channel ic = ic |> Lexing.from_channel |> parse_from let filter_from_file filename = filename |> open_in |> filter_from_channel let pair_of_strings = Predicate.pair_of_strings -let apply_filter = - Predicate.filter_to_predicate ~match_fun:Match_in_order.match_operation +let apply_filter ?(match_fun = Match_in_order.match_operation) = + Predicate.filter_to_predicate ~match_fun -let apply_list_filter = - Combiner.apply_list_of_filters_for_pair - ~match_fun:Match_in_order.match_operation ~equal_fun:CCString.equal +let apply_list_filter ?(match_fun = Match_in_order.match_operation) = + Combiner.apply_list_of_filters_for_pair ~match_fun ~equal_fun:CCString.equal -let apply_list_filter_for_pairs = - Combiner.apply_list_of_filters_for_list_of_pairs - ~match_fun:Match_in_order.match_operation ~equal_fun:CCString.equal +let apply_list_filter_for_pairs ?(match_fun = Match_in_order.match_operation) = + Combiner.apply_list_of_filters_for_list_of_pairs ~match_fun + ~equal_fun:CCString.equal From 2360f19b35ee7b6e3447bb5286e9c9a0c62dc7c4 Mon Sep 17 00:00:00 2001 From: Paul Monson Date: Sun, 24 Dec 2023 08:18:44 -0600 Subject: [PATCH 08/12] remove type varialbe in favor of string --- compiler/ast.ml | 23 ++++---- compiler/ast.mli | 96 ++++++++++++++++----------------- compiler/combiner.mli | 14 ++--- compiler/fex_compiler.ml | 4 +- compiler/fex_compiler.mli | 14 ++--- compiler/filter_parser.mly | 2 +- compiler/match_in_order.ml | 4 +- compiler/match_in_order.mli | 6 +-- compiler/predicate.mli | 4 +- compiler_test/messages_test.ml | 6 +-- compiler_test/parser_test.ml | 6 +-- compiler_test/predicate_test.ml | 6 +-- 12 files changed, 87 insertions(+), 98 deletions(-) diff --git a/compiler/ast.ml b/compiler/ast.ml index 167aa0b..93af976 100644 --- a/compiler/ast.ml +++ b/compiler/ast.ml @@ -24,11 +24,11 @@ module Number = struct (String.trim s, i, rf) end -type 'a string_match_operation = - | ExactString of 'a - | ContainsString of 'a list - | BeginsWithString of 'a list - | EndsWithString of 'a list +type string_match_operation = + | ExactString of string + | ContainsString of string list + | BeginsWithString of string list + | EndsWithString of string list [@@deriving show, eq] type number = Number.t [@@deriving show, eq, ord] @@ -40,16 +40,15 @@ type number_match_operation = | BetweenNumber of number * number [@@deriving show, eq] -type 'a match_operation = - | StringOp of 'a string_match_operation +type match_operation = + | StringOp of string_match_operation | NumberOp of number_match_operation [@@deriving show, eq] -type 'a t = - | ValueFilter of match_operation_result * 'a match_operation - | KeyFilter of match_operation_result * 'a match_operation - | PairFilter of - match_operation_result * 'a match_operation * 'a match_operation +type t = + | ValueFilter of match_operation_result * match_operation + | KeyFilter of match_operation_result * match_operation + | PairFilter of match_operation_result * match_operation * match_operation [@@deriving show, eq] let exc = Exclude diff --git a/compiler/ast.mli b/compiler/ast.mli index 489e309..71953c8 100644 --- a/compiler/ast.mli +++ b/compiler/ast.mli @@ -26,11 +26,11 @@ type 'a match_type = ] (** The type of operation to use in the the filter *) -type 'a string_match_operation = - | ExactString of 'a - | ContainsString of 'a list - | BeginsWithString of 'a list - | EndsWithString of 'a list +type string_match_operation = + | ExactString of string + | ContainsString of string list + | BeginsWithString of string list + | EndsWithString of string list type number_match_operation = | ExactNumber of number @@ -38,20 +38,20 @@ type number_match_operation = | GreaterThanNumber of number | BetweenNumber of number * number -type 'a match_operation = - | StringOp of 'a string_match_operation +type match_operation = + | StringOp of string_match_operation | NumberOp of number_match_operation (** The full AST including opterations and include vs exclude result *) -type 'a t = - | ValueFilter of match_operation_result * 'a match_operation - | KeyFilter of match_operation_result * 'a match_operation - | PairFilter of - match_operation_result * 'a match_operation * 'a match_operation +type t = + | ValueFilter of match_operation_result * match_operation + | KeyFilter of match_operation_result * match_operation + | PairFilter of match_operation_result * match_operation * match_operation +[@@deriving eq, show] -val pp : (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a t -> unit -val show : (Format.formatter -> 'a -> unit) -> 'a t -> string -val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool +(* val pp : (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a t -> unit *) +(* val show : (Format.formatter -> 'a -> unit) -> 'a t -> string *) +(* val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool *) (** {1 Helpers } @@ -73,74 +73,74 @@ val inc : match_operation_result Helpers to build operations *) -val begins_with : 'a -> 'a match_operation +val begins_with : string -> match_operation (** [begins_with s] Begins with builder for a single ['string] *) -val begins_with_in_order : 'a list -> 'a match_operation +val begins_with_in_order : string list -> match_operation (** [begins_with_in_order lst] Begin with operation builder for a list of ['string]. *) -val contains : 'a -> 'a match_operation +val contains : string -> match_operation (** [contains s] Contains operation builder for a single ['string] *) -val contains_in_order : 'a list -> 'a match_operation +val contains_in_order : string list -> match_operation (** [contains_in_order lst] Conatins operation build for list of ['string]s *) -val ends_with : 'a -> 'a match_operation +val ends_with : string -> match_operation (** [ends_with s] Ends with operation builder for single ['string] *) -val ends_with_in_order : 'a list -> 'a match_operation +val ends_with_in_order : string list -> match_operation (** [ends_with_in_order lst] Ends with operation builder for a list of ['string]s *) -val exact : 'a -> 'a match_operation +val exact : string -> match_operation (** [exact str] Exact match operation builder for a single ['string] *) -val contains_key : ?op:match_operation_result -> 'a -> 'a t +val contains_key : ?op:match_operation_result -> string -> t (** [contains_key ?result k] Contains match operation builder for a single ['string] *) -val contains_pair : ?op:match_operation_result -> 'a -> 'a -> 'a t +val contains_pair : ?op:match_operation_result -> string -> string -> t (** [contains_pair ?result k v] Contains a pair with the key of k and a value of v *) -val contains_value : ?op:match_operation_result -> 'a -> 'a t +val contains_value : ?op:match_operation_result -> string -> t (** [contains_value ?result v] Contains a value of v *) -val exact_of_int : int -> 'a match_operation -val exact_of_float : float -> 'a match_operation -val exact_of_string : string -> 'a match_operation -val exact_of_num : number -> 'a match_operation -val less_than_of_int : int -> 'a match_operation -val less_than_of_float : float -> 'a match_operation -val less_than_of_string : string -> 'a match_operation -val less_than : number -> 'a match_operation -val greater_than_of_int : int -> 'a match_operation -val greater_than_of_float : float -> 'a match_operation -val greater_than_of_string : string -> 'a match_operation -val greater_than : number -> 'a match_operation -val between_of_int : int -> int -> 'a match_operation -val between_of_float : float -> float -> 'a match_operation -val between_of_string : string -> string -> 'a match_operation -val between : number -> number -> 'a match_operation +val exact_of_int : int -> match_operation +val exact_of_float : float -> match_operation +val exact_of_string : string -> match_operation +val exact_of_num : number -> match_operation +val less_than_of_int : int -> match_operation +val less_than_of_float : float -> match_operation +val less_than_of_string : string -> match_operation +val less_than : number -> match_operation +val greater_than_of_int : int -> match_operation +val greater_than_of_float : float -> match_operation +val greater_than_of_string : string -> match_operation +val greater_than : number -> match_operation +val between_of_int : int -> int -> match_operation +val between_of_float : float -> float -> match_operation +val between_of_string : string -> string -> match_operation +val between : number -> number -> match_operation (** {2 Ast helpers} *) val pair_filter : - match_operation_result -> 'a match_operation -> 'a match_operation -> 'a t + match_operation_result -> match_operation -> match_operation -> t (** [pair_filter result key_op value_op] Ast builder for a pair filter *) -val key_filter : match_operation_result -> 'a match_operation -> 'a t +val key_filter : match_operation_result -> match_operation -> t (** [key_filter result op] Ast builder for a key filter *) -val value_filter : match_operation_result -> 'a match_operation -> 'a t +val value_filter : match_operation_result -> match_operation -> t (** [value_filter result value_op] Ast builder for a value filter *) -val is_exclude : 'a t -> bool +val is_exclude : t -> bool (** [is_exclude ast] Check if an ast is exclude *) -val is_include : 'a t -> bool +val is_include : t -> bool (** [is_include ast] Check if an ast is include *) val number_of_int : int -> number val number_of_float : float -> number val number_of_string : string -> number -val string_op_of_op : 'a match_operation -> 'a string_match_operation option -val number_op_of_op : 'a match_operation -> number_match_operation option +val string_op_of_op : match_operation -> string_match_operation option +val number_op_of_op : match_operation -> number_match_operation option val number_comp : number -> number -> int diff --git a/compiler/combiner.mli b/compiler/combiner.mli index 8ab5cc2..8d8ca69 100644 --- a/compiler/combiner.mli +++ b/compiler/combiner.mli @@ -1,16 +1,16 @@ val imply_logical_operators : - equal_fun:('a -> 'a -> bool) -> 'a Ast.t list -> 'a Ast.t list list + equal_fun:(string -> string -> bool) -> Ast.t list -> Ast.t list list val apply_list_of_filters_for_pair : - match_fun:('a Ast.match_type -> 'a Ast.match_operation -> bool) - -> equal_fun:('a -> 'a -> bool) - -> 'a Ast.t list + match_fun:('a Ast.match_type -> Ast.match_operation -> bool) + -> equal_fun:(string -> string -> bool) + -> Ast.t list -> 'a Predicate.pair -> bool val apply_list_of_filters_for_list_of_pairs : - match_fun:('a Ast.match_type -> 'a Ast.match_operation -> bool) - -> equal_fun:('a -> 'a -> bool) - -> 'a Ast.t list + match_fun:('a Ast.match_type -> Ast.match_operation -> bool) + -> equal_fun:(string -> string -> bool) + -> Ast.t list -> 'a Predicate.pair list -> bool diff --git a/compiler/fex_compiler.ml b/compiler/fex_compiler.ml index fe71c37..d5576af 100644 --- a/compiler/fex_compiler.ml +++ b/compiler/fex_compiler.ml @@ -7,7 +7,7 @@ module Combiner = Combiner exception Grammar_error of string -type parsed_result = (string Ast.t list, string) result [@@deriving show] +type parsed_result = (Ast.t list, string) result [@@deriving show] exception Syntax_error of ((int * int * int option) option * string) @@ -26,7 +26,7 @@ let get_parse_error env = with Not_found -> (None, "invalid syntax (no specific message for this eror)")) -let rec parse lexbuf (checkpoint : string Ast.t list I.checkpoint) = +let rec parse lexbuf (checkpoint : Ast.t list I.checkpoint) = match checkpoint with | I.InputNeeded _env -> let token = Filter_lexer.read_tokens lexbuf in diff --git a/compiler/fex_compiler.mli b/compiler/fex_compiler.mli index f700fff..d335bf1 100644 --- a/compiler/fex_compiler.mli +++ b/compiler/fex_compiler.mli @@ -3,7 +3,7 @@ module Predicate = Predicate module Matcher = Match_in_order module Combiner = Combiner -type parsed_result = (string Ast.t list, string) result +type parsed_result = (Ast.t list, string) result (** A result from parsing a fex query. *) val pp_parsed_result : Format.formatter -> parsed_result -> unit @@ -22,22 +22,22 @@ val pair_of_strings : string -> string -> string Predicate.pair (** constructor for a pair of strings, useful to convert a source before appling a filter. *) val apply_filter : - ?match_fun:(string Ast.match_type -> string Ast.match_operation -> bool) - -> string Ast.t + ?match_fun:(string Ast.match_type -> Ast.match_operation -> bool) + -> Ast.t -> string Predicate.pair -> bool (** Does the filtering work on the pair, one filter and one pair. *) val apply_list_filter : - ?match_fun:(string Ast.match_type -> string Ast.match_operation -> bool) - -> string Ast.t list + ?match_fun:(string Ast.match_type -> Ast.match_operation -> bool) + -> Ast.t list -> string Predicate.pair -> bool (** Does the filtering of a group of filters on a single pair. *) val apply_list_filter_for_pairs : - ?match_fun:(string Ast.match_type -> string Ast.match_operation -> bool) - -> string Ast.t list + ?match_fun:(string Ast.match_type -> Ast.match_operation -> bool) + -> Ast.t list -> string Predicate.pair list -> bool (** Does the filtering of a group of filters on a list of pairs. *) diff --git a/compiler/filter_parser.mly b/compiler/filter_parser.mly index 9c5d2db..a708a8f 100644 --- a/compiler/filter_parser.mly +++ b/compiler/filter_parser.mly @@ -12,7 +12,7 @@ %token R_ANGLE ">" %token EOF -%start terms +%start terms %% op_result: diff --git a/compiler/match_in_order.ml b/compiler/match_in_order.ml index 6ffe6cf..87409b7 100644 --- a/compiler/match_in_order.ml +++ b/compiler/match_in_order.ml @@ -31,7 +31,7 @@ let ends_with_in_order ~subs to_check = (CCString.rev to_check) let string_match_operation (from_input : string) - (match_op : string Ast.string_match_operation) : bool = + (match_op : Ast.string_match_operation) : bool = let open CCString in match match_op with | ExactString expected -> @@ -62,7 +62,7 @@ let number_match_operation (from_input : Ast.number) && Ast.number_comp lower from_input == -1 let match_operation (typed_from_input : string Ast.match_type) - (op : string Ast.match_operation) : bool = + (op : Ast.match_operation) : bool = match typed_from_input with | `String s -> ( match Ast.string_op_of_op op with diff --git a/compiler/match_in_order.mli b/compiler/match_in_order.mli index fa7d71d..fe76490 100644 --- a/compiler/match_in_order.mli +++ b/compiler/match_in_order.mli @@ -1,7 +1,5 @@ -val match_operation : - string Ast.match_type -> string Ast.match_operation -> bool - -val string_match_operation : string -> string Ast.string_match_operation -> bool +val match_operation : string Ast.match_type -> Ast.match_operation -> bool +val string_match_operation : string -> Ast.string_match_operation -> bool val number_match_operation : Ast.number -> Ast.number_match_operation -> bool module T : sig diff --git a/compiler/predicate.mli b/compiler/predicate.mli index 3a1632c..1a0feda 100644 --- a/compiler/predicate.mli +++ b/compiler/predicate.mli @@ -3,8 +3,8 @@ type 'a value = [ `Value of [ `String of 'a | `Int of int | `Float of float ] ] type 'a pair = [ `Pair of 'a key * 'a value ] val filter_to_predicate : - match_fun:('a Ast.match_type -> 'a Ast.match_operation -> bool) - -> 'a Ast.t + match_fun:('a Ast.match_type -> Ast.match_operation -> bool) + -> Ast.t -> 'a pair -> bool diff --git a/compiler_test/messages_test.ml b/compiler_test/messages_test.ml index d013dee..c9cb79f 100644 --- a/compiler_test/messages_test.ml +++ b/compiler_test/messages_test.ml @@ -2,11 +2,7 @@ let test_name = "Parser Messages" let fex = let open Alcotest in - let string_pp = Fex_compiler.Ast.pp Fex_compiler__Match_in_order.T.pp in - let string_equal = - Fex_compiler.Ast.equal Fex_compiler__Match_in_order.T.equal - in - testable string_pp string_equal + Fex_compiler.Ast.(testable pp equal) let parse = Fex_compiler.filter_from_string diff --git a/compiler_test/parser_test.ml b/compiler_test/parser_test.ml index 15785cd..bb69fec 100644 --- a/compiler_test/parser_test.ml +++ b/compiler_test/parser_test.ml @@ -2,11 +2,7 @@ let test_name = "Filter Parser" let fex = let open Alcotest in - let string_pp = Fex_compiler.Ast.pp Fex_compiler__Match_in_order.T.pp in - let string_equal = - Fex_compiler.Ast.equal Fex_compiler__Match_in_order.T.equal - in - testable string_pp string_equal + Fex_compiler.Ast.(testable pp equal) let parse = Fex_compiler.filter_from_string diff --git a/compiler_test/predicate_test.ml b/compiler_test/predicate_test.ml index d387e4c..e868a69 100644 --- a/compiler_test/predicate_test.ml +++ b/compiler_test/predicate_test.ml @@ -9,7 +9,7 @@ let make_key_test op_result filter expected = let filter' = Fex_compiler.Ast.key_filter op_result filter in Alcotest.( check bool - (Fex_compiler.Ast.show string_pp filter' ^ {| to ("key", "value") |}) + (Fex_compiler.Ast.show filter' ^ {| to ("key", "value") |}) expected (filter_to_bool filter' (Fex_compiler.pair_of_strings "key" "value"))) @@ -18,7 +18,7 @@ let make_value_test op_result filter expected = let filter' = value_filter op_result filter in Alcotest.( check bool - (show string_pp filter' ^ {| to ("key", "value") |}) + (show filter' ^ {| to ("key", "value") |}) expected (filter_to_bool filter' (Fex_compiler.pair_of_strings "key" "value"))) @@ -28,7 +28,7 @@ let make_pair_test op_result key_filter value_filter expected = in Alcotest.( check bool - (Fex_compiler.Ast.show string_pp filter' ^ {| to ("key", "value") |}) + (Fex_compiler.Ast.show filter' ^ {| to ("key", "value") |}) expected (filter_to_bool filter' (Fex_compiler.pair_of_strings "key" "value"))) From 2fc054b598c0c42d7e465cc4e45a8e1f1f4cc41f Mon Sep 17 00:00:00 2001 From: Paul Monson Date: Sun, 24 Dec 2023 20:55:18 -0600 Subject: [PATCH 09/12] removal of match-type variant --- compiler/ast.ml | 4 +-- compiler/ast.mli | 11 ++++--- compiler/combiner.ml | 55 ++++++++++++++++++++-------------- compiler/combiner.mli | 27 ++++++++++++----- compiler/fex_compiler.ml | 3 +- compiler/fex_compiler.mli | 14 ++++----- compiler/match_in_order.ml | 2 +- compiler/match_in_order.mli | 2 +- compiler/predicate.ml | 18 +++++------ compiler/predicate.mli | 12 ++++---- compiler_test/combiner_test.ml | 12 ++++---- 11 files changed, 88 insertions(+), 72 deletions(-) diff --git a/compiler/ast.ml b/compiler/ast.ml index 93af976..bc59ea8 100644 --- a/compiler/ast.ml +++ b/compiler/ast.ml @@ -3,8 +3,8 @@ type match_operation_result = | Exclude [@@deriving show, eq] -type 'a match_type = - [ `String of 'a +type match_type = + [ `String of string | `Int of int | `Float of float ] diff --git a/compiler/ast.mli b/compiler/ast.mli index 71953c8..eddaa11 100644 --- a/compiler/ast.mli +++ b/compiler/ast.mli @@ -19,8 +19,8 @@ type number = string * int * float option val equal_number : number -> number -> bool val compare_number : number -> number -> int -type 'a match_type = - [ `String of 'a +type match_type = + [ `String of string | `Int of int | `Float of float ] @@ -47,11 +47,10 @@ type t = | ValueFilter of match_operation_result * match_operation | KeyFilter of match_operation_result * match_operation | PairFilter of match_operation_result * match_operation * match_operation -[@@deriving eq, show] -(* val pp : (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a t -> unit *) -(* val show : (Format.formatter -> 'a -> unit) -> 'a t -> string *) -(* val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool *) +val pp : Format.formatter -> t -> unit +val show : t -> string +val equal : t -> t -> bool (** {1 Helpers } diff --git a/compiler/combiner.ml b/compiler/combiner.ml index 599f8aa..a9177e4 100644 --- a/compiler/combiner.ml +++ b/compiler/combiner.ml @@ -1,16 +1,16 @@ -type 'a t = +type t = | IncludeValueGroup | ExcludeValueGroup | IncludeKeyGroup | ExcludeKeyGroup - | IncludePairGroupExactString of 'a - | IncludePairGroupContainsString of 'a list - | IncludePairGroupBeginsWithString of 'a list - | IncludePairGroupEndsWithString of 'a list - | ExcludePairGroupExactString of 'a - | ExcludePairGroupContainsString of 'a list - | ExcludePairGroupBeginsWithString of 'a list - | ExcludePairGroupEndsWithString of 'a list + | IncludePairGroupExactString of string + | IncludePairGroupContainsString of string list + | IncludePairGroupBeginsWithString of string list + | IncludePairGroupEndsWithString of string list + | ExcludePairGroupExactString of string + | ExcludePairGroupContainsString of string list + | ExcludePairGroupBeginsWithString of string list + | ExcludePairGroupEndsWithString of string list | IncludePairGroupExactNumber of Ast.number | IncludePairGroupLessThanNumber of Ast.number | IncludePairGroupGreaterThanNumber of Ast.number @@ -21,7 +21,7 @@ type 'a t = | ExcludePairGroupBetweenNumber of Ast.number * Ast.number [@@deriving eq] -let group_as ~equal_fun a b = +let as_group a b = let categorize = let open Ast in function @@ -64,7 +64,7 @@ let group_as ~equal_fun a b = in let category_a = categorize a in let category_b = categorize b in - equal equal_fun category_a category_b + equal category_a category_b let group ~fn lst = let rec grouping acc = function @@ -75,19 +75,20 @@ let group ~fn lst = in grouping [] lst -let imply_logical_operators ~equal_fun a = group ~fn:(group_as ~equal_fun) a +let imply_logical_operators a = group ~fn:as_group a +let apply ~fn groups = List.for_all fn groups +let apply_list = apply -let apply_list_of_filters_for_pair ~match_fun ~equal_fun lst pair = - let and_group = imply_logical_operators ~equal_fun lst in - let if_has_one = - List.exists (fun filter -> - Predicate.filter_to_predicate ~match_fun filter pair) - in - List.for_all if_has_one and_group +let list_of_filters_for_pair ~match_fun pair = + List.exists (fun filter -> + Predicate.filter_to_predicate ~match_fun filter pair) + +let apply_list_of_filters_for_pair ~match_fun lst pair = + let and_group = imply_logical_operators lst in + let if_has_one = list_of_filters_for_pair ~match_fun pair in + apply ~fn:if_has_one and_group -let apply_list_of_filters_for_list_of_pairs ~match_fun ~equal_fun lst - (pairs : 'a Predicate.pair list) = - let and_group = imply_logical_operators ~equal_fun lst in +let list_of_filters_for_list_of_pairs ~match_fun (pairs : Predicate.pair list) = let apply_logic group = let hd = List.hd group in match Ast.is_include hd with @@ -102,4 +103,12 @@ let apply_list_of_filters_for_list_of_pairs ~match_fun ~equal_fun lst List.for_all (Predicate.filter_to_predicate ~match_fun filter) pairs) group in - List.for_all apply_logic and_group + apply_logic + +let apply_list_of_filters_for_list_of_pairs ~match_fun lst + (pairs : Predicate.pair list) = + let and_group = imply_logical_operators lst in + let (apply_logic : Ast.t list -> bool) = + list_of_filters_for_list_of_pairs ~match_fun pairs + in + apply ~fn:apply_logic and_group diff --git a/compiler/combiner.mli b/compiler/combiner.mli index 8d8ca69..084a7cf 100644 --- a/compiler/combiner.mli +++ b/compiler/combiner.mli @@ -1,16 +1,27 @@ -val imply_logical_operators : - equal_fun:(string -> string -> bool) -> Ast.t list -> Ast.t list list +val imply_logical_operators : Ast.t list -> Ast.t list list +val apply : fn:(Ast.t -> bool) -> Ast.t list -> bool +val apply_list : fn:(Ast.t list -> bool) -> Ast.t list list -> bool val apply_list_of_filters_for_pair : - match_fun:('a Ast.match_type -> Ast.match_operation -> bool) - -> equal_fun:(string -> string -> bool) + match_fun:(Ast.match_type -> Ast.match_operation -> bool) -> Ast.t list - -> 'a Predicate.pair + -> Predicate.pair -> bool val apply_list_of_filters_for_list_of_pairs : - match_fun:('a Ast.match_type -> Ast.match_operation -> bool) - -> equal_fun:(string -> string -> bool) + match_fun:(Ast.match_type -> Ast.match_operation -> bool) + -> Ast.t list + -> Predicate.pair list + -> bool + +val list_of_filters_for_list_of_pairs : + match_fun:(Ast.match_type -> Ast.match_operation -> bool) + -> Predicate.pair list + -> Ast.t list + -> bool + +val list_of_filters_for_pair : + match_fun:(Ast.match_type -> Ast.match_operation -> bool) + -> Predicate.pair -> Ast.t list - -> 'a Predicate.pair list -> bool diff --git a/compiler/fex_compiler.ml b/compiler/fex_compiler.ml index d5576af..784924a 100644 --- a/compiler/fex_compiler.ml +++ b/compiler/fex_compiler.ml @@ -70,8 +70,7 @@ let apply_filter ?(match_fun = Match_in_order.match_operation) = Predicate.filter_to_predicate ~match_fun let apply_list_filter ?(match_fun = Match_in_order.match_operation) = - Combiner.apply_list_of_filters_for_pair ~match_fun ~equal_fun:CCString.equal + Combiner.apply_list_of_filters_for_pair ~match_fun let apply_list_filter_for_pairs ?(match_fun = Match_in_order.match_operation) = Combiner.apply_list_of_filters_for_list_of_pairs ~match_fun - ~equal_fun:CCString.equal diff --git a/compiler/fex_compiler.mli b/compiler/fex_compiler.mli index d335bf1..5514b96 100644 --- a/compiler/fex_compiler.mli +++ b/compiler/fex_compiler.mli @@ -18,26 +18,26 @@ val filter_from_string : string -> parsed_result val filter_from_file : string -> parsed_result (** Gets the filter ast from a file. *) -val pair_of_strings : string -> string -> string Predicate.pair +val pair_of_strings : string -> string -> Predicate.pair (** constructor for a pair of strings, useful to convert a source before appling a filter. *) val apply_filter : - ?match_fun:(string Ast.match_type -> Ast.match_operation -> bool) + ?match_fun:(Ast.match_type -> Ast.match_operation -> bool) -> Ast.t - -> string Predicate.pair + -> Predicate.pair -> bool (** Does the filtering work on the pair, one filter and one pair. *) val apply_list_filter : - ?match_fun:(string Ast.match_type -> Ast.match_operation -> bool) + ?match_fun:(Ast.match_type -> Ast.match_operation -> bool) -> Ast.t list - -> string Predicate.pair + -> Predicate.pair -> bool (** Does the filtering of a group of filters on a single pair. *) val apply_list_filter_for_pairs : - ?match_fun:(string Ast.match_type -> Ast.match_operation -> bool) + ?match_fun:(Ast.match_type -> Ast.match_operation -> bool) -> Ast.t list - -> string Predicate.pair list + -> Predicate.pair list -> bool (** Does the filtering of a group of filters on a list of pairs. *) diff --git a/compiler/match_in_order.ml b/compiler/match_in_order.ml index 87409b7..3c3055c 100644 --- a/compiler/match_in_order.ml +++ b/compiler/match_in_order.ml @@ -61,7 +61,7 @@ let number_match_operation (from_input : Ast.number) Ast.number_comp from_input upper == -1 && Ast.number_comp lower from_input == -1 -let match_operation (typed_from_input : string Ast.match_type) +let match_operation (typed_from_input : Ast.match_type) (op : Ast.match_operation) : bool = match typed_from_input with | `String s -> ( diff --git a/compiler/match_in_order.mli b/compiler/match_in_order.mli index fe76490..d13c88c 100644 --- a/compiler/match_in_order.mli +++ b/compiler/match_in_order.mli @@ -1,4 +1,4 @@ -val match_operation : string Ast.match_type -> Ast.match_operation -> bool +val match_operation : Ast.match_type -> Ast.match_operation -> bool val string_match_operation : string -> Ast.string_match_operation -> bool val number_match_operation : Ast.number -> Ast.number_match_operation -> bool diff --git a/compiler/predicate.ml b/compiler/predicate.ml index 6f3fc6a..7cc240c 100644 --- a/compiler/predicate.ml +++ b/compiler/predicate.ml @@ -1,21 +1,21 @@ -type 'a match_type = - [ `String of 'a +type match_type = + [ `String of string | `Int of int | `Float of float ] -type 'a key = [ `Key of [ `String of 'a ] ] -type 'a value = [ `Value of 'a match_type ] -type 'a pair = [ `Pair of 'a key * 'a value ] +type key = [ `Key of [ `String of string ] ] +type value = [ `Value of match_type ] +type pair = [ `Pair of key * value ] let invert = Bool.not -let match_operation ~match_fun op (m : 'a match_type) : bool = match_fun m op -let match_type_of_string str : 'a match_type = `String str +let match_operation ~match_fun op (m : match_type) : bool = match_fun m op +let match_type_of_string str : match_type = `String str -let key_match_operation ~match_fun op (`Key (`String k) : 'a key) : bool = +let key_match_operation ~match_fun op (`Key (`String k) : key) : bool = match_operation ~match_fun op @@ match_type_of_string k -let value_match_operation ~match_fun op (`Value v : 'a value) : bool = +let value_match_operation ~match_fun op (`Value v : value) : bool = match_fun v op let filter_to_predicate ~match_fun ast pair = diff --git a/compiler/predicate.mli b/compiler/predicate.mli index 1a0feda..a143071 100644 --- a/compiler/predicate.mli +++ b/compiler/predicate.mli @@ -1,11 +1,11 @@ -type 'a key = [ `Key of [ `String of 'a ] ] -type 'a value = [ `Value of [ `String of 'a | `Int of int | `Float of float ] ] -type 'a pair = [ `Pair of 'a key * 'a value ] +type key = [ `Key of [ `String of string ] ] +type value = [ `Value of [ `String of string | `Int of int | `Float of float ] ] +type pair = [ `Pair of key * value ] val filter_to_predicate : - match_fun:('a Ast.match_type -> Ast.match_operation -> bool) + match_fun:(Ast.match_type -> Ast.match_operation -> bool) -> Ast.t - -> 'a pair + -> pair -> bool -val pair_of_strings : 'a -> 'a -> 'a pair +val pair_of_strings : string -> string -> pair diff --git a/compiler_test/combiner_test.ml b/compiler_test/combiner_test.ml index ed9b6dd..aa964b7 100644 --- a/compiler_test/combiner_test.ml +++ b/compiler_test/combiner_test.ml @@ -1,10 +1,9 @@ let test_name = "Combiner" -let equal_fun = CCString.equal let filter_list_to_bool to_check with_filters = - Fex_compiler__Combiner.apply_list_of_filters_for_list_of_pairs - ~match_fun:Fex_compiler__Match_in_order.match_operation ~equal_fun to_check - with_filters + let match_fun = Fex_compiler.Matcher.match_operation in + Fex_compiler__Combiner.apply_list_of_filters_for_list_of_pairs ~match_fun + to_check with_filters let empty () = Alcotest.(check bool "empty" true (filter_list_to_bool [] [])) @@ -16,11 +15,10 @@ let simple_implies () = let contains_bb = pair_filter inc (exact "b") (contains "b") in Alcotest.( check bool {|[["a"; "b"]] matches `a,c`|} true - (Fex_compiler__Combiner.imply_logical_operators ~equal_fun - [ contains_a; contains_b ] + (Fex_compiler__Combiner.imply_logical_operators [ contains_a; contains_b ] = [ [ contains_a; contains_b ] ]) ; check bool {|[["a:a"; "b:b"]] matches `a:a,b:b`|} true - (Fex_compiler__Combiner.imply_logical_operators ~equal_fun + (Fex_compiler__Combiner.imply_logical_operators [ contains_aa; contains_bb ] = [ [ contains_bb ]; [ contains_aa ] ])) From c4858f6b5df9d91e7c3328bc928617fcdc6c7969 Mon Sep 17 00:00:00 2001 From: Paul Monson Date: Tue, 26 Dec 2023 17:17:18 -0600 Subject: [PATCH 10/12] Utilize match_type in predicate and combiner --- bin/fex.ml | 7 +++++-- compiler/ast.ml | 7 +++---- compiler/ast.mli | 7 +++---- compiler/match_in_order.ml | 6 +++--- compiler/predicate.ml | 30 ++++++++++++++---------------- compiler/predicate.mli | 11 ++++++++--- compiler_test/combiner_test.ml | 20 ++++++-------------- 7 files changed, 42 insertions(+), 46 deletions(-) diff --git a/bin/fex.ml b/bin/fex.ml index e49b874..a443fb3 100644 --- a/bin/fex.ml +++ b/bin/fex.ml @@ -9,7 +9,7 @@ let sprint_key (`Pair (`Key key, _value)) = sprint_value key let sprint_pair (`Pair (_key, `Value value)) = sprint_value value let fex_record_op fex json = - let list_of_pairs = + let (list_of_pairs : Fex_flattener.pairs list) = match json with | `List lst -> Fex_flattener.pairs_from_json_array (`List lst) | _ -> @@ -17,7 +17,10 @@ let fex_record_op fex json = exit 124 in let print_for_pairs filter_lst pairs = - if Fex_compiler.apply_list_filter_for_pairs filter_lst pairs then ( + if + Fex_compiler.apply_list_filter_for_pairs filter_lst + (List.map Fex_compiler.Predicate.pair_of pairs) + then ( try List.iter sprint_pair pairs ; print_newline () diff --git a/compiler/ast.ml b/compiler/ast.ml index bc59ea8..fdc7f54 100644 --- a/compiler/ast.ml +++ b/compiler/ast.ml @@ -4,10 +4,9 @@ type match_operation_result = [@@deriving show, eq] type match_type = - [ `String of string - | `Int of int - | `Float of float - ] + | String of string + | Int of int + | Float of float module Number = struct type t = string * int * float option [@@deriving show, ord] diff --git a/compiler/ast.mli b/compiler/ast.mli index eddaa11..70e5f43 100644 --- a/compiler/ast.mli +++ b/compiler/ast.mli @@ -20,10 +20,9 @@ val equal_number : number -> number -> bool val compare_number : number -> number -> int type match_type = - [ `String of string - | `Int of int - | `Float of float - ] + | String of string + | Int of int + | Float of float (** The type of operation to use in the the filter *) type string_match_operation = diff --git a/compiler/match_in_order.ml b/compiler/match_in_order.ml index 3c3055c..2ec77f2 100644 --- a/compiler/match_in_order.ml +++ b/compiler/match_in_order.ml @@ -64,15 +64,15 @@ let number_match_operation (from_input : Ast.number) let match_operation (typed_from_input : Ast.match_type) (op : Ast.match_operation) : bool = match typed_from_input with - | `String s -> ( + | String s -> ( match Ast.string_op_of_op op with | Some string_op -> string_match_operation s string_op | None -> false) - | `Int i -> ( + | Int i -> ( match Ast.number_op_of_op op with | Some num_op -> number_match_operation (Ast.number_of_int i) num_op | None -> false) - | `Float f -> ( + | Float f -> ( match Ast.number_op_of_op op with | Some num_op -> number_match_operation (Ast.number_of_float f) num_op | None -> false) diff --git a/compiler/predicate.ml b/compiler/predicate.ml index 7cc240c..42fa8cc 100644 --- a/compiler/predicate.ml +++ b/compiler/predicate.ml @@ -1,27 +1,25 @@ -type match_type = - [ `String of string - | `Int of int - | `Float of float - ] - -type key = [ `Key of [ `String of string ] ] -type value = [ `Value of match_type ] -type pair = [ `Pair of key * value ] +type pair = string * Ast.match_type let invert = Bool.not -let match_operation ~match_fun op (m : match_type) : bool = match_fun m op -let match_type_of_string str : match_type = `String str +let match_operation ~match_fun op (m : Ast.match_type) : bool = match_fun m op +let match_type_of_string str : Ast.match_type = String str -let key_match_operation ~match_fun op (`Key (`String k) : key) : bool = +let key_match_operation ~match_fun op (k : string) : bool = match_operation ~match_fun op @@ match_type_of_string k -let value_match_operation ~match_fun op (`Value v : value) : bool = +let value_match_operation ~match_fun op (v : Ast.match_type) : bool = match_fun v op +let pair_of (`Pair (`Key (`String k), `Value v)) = + match v with + | `String s -> (k, Ast.String s) + | `Int i -> (k, Ast.Int i) + | `Float f -> (k, Ast.Float f) + let filter_to_predicate ~match_fun ast pair = let open Ast in - let (`Pair (_, value)) = pair in - let (`Pair (key, _)) = pair in + let _, value = pair in + let key, _ = pair in match ast with | ValueFilter (Include, match_op) -> value_match_operation ~match_fun match_op value @@ -38,4 +36,4 @@ let filter_to_predicate ~match_fun ast pair = | false -> true | true -> invert @@ value_match_operation ~match_fun value_match_op value) -let pair_of_strings k v = `Pair (`Key (`String k), `Value (`String v)) +let pair_of_strings k v = (k, Ast.String v) diff --git a/compiler/predicate.mli b/compiler/predicate.mli index a143071..d6bb7ce 100644 --- a/compiler/predicate.mli +++ b/compiler/predicate.mli @@ -1,6 +1,4 @@ -type key = [ `Key of [ `String of string ] ] -type value = [ `Value of [ `String of string | `Int of int | `Float of float ] ] -type pair = [ `Pair of key * value ] +type pair = string * Ast.match_type val filter_to_predicate : match_fun:(Ast.match_type -> Ast.match_operation -> bool) @@ -9,3 +7,10 @@ val filter_to_predicate : -> bool val pair_of_strings : string -> string -> pair + +val pair_of : + [ `Pair of + [ `Key of [ `String of string ] ] + * [ `Value of [ `String of string | `Int of int | `Float of float ] ] + ] + -> pair diff --git a/compiler_test/combiner_test.ml b/compiler_test/combiner_test.ml index aa964b7..308e592 100644 --- a/compiler_test/combiner_test.ml +++ b/compiler_test/combiner_test.ml @@ -27,7 +27,7 @@ let two_include_union () = let contains_ab_or_c = [ value_filter inc (contains "a"); value_filter inc (contains "c") ] in - let pair_of_value value = `Pair (`Key (`String ""), `Value (`String value)) in + let pair_of_value value = ("", String value) in let make_test expected str_value = Alcotest.( check bool @@ -47,7 +47,7 @@ let one_include_one_exclude_union () = let contains_ab_or_c = [ value_filter inc (contains "a"); value_filter exc (contains "c") ] in - let pair_of_value value = `Pair (`Key (`String ""), `Value (`String value)) in + let pair_of_value value = ("", String value) in let make_test expected str_value = Alcotest.( check bool @@ -69,9 +69,7 @@ let paired_union () = ; pair_filter inc (exact "a") (contains "b") ] in - let pair_of_keyed_a value = - `Pair (`Key (`String "a"), `Value (`String value)) - in + let pair_of_keyed_a value = ("a", String value) in let make_test expected str_value = Alcotest.( check bool @@ -96,9 +94,7 @@ let mixed_paired_union () = ; pair_filter inc (exact "a") (contains "b") ] in - let pair_of_keyed_a value = - `Pair (`Key (`String "a"), `Value (`String value)) - in + let pair_of_keyed_a value = ("a", String value) in let make_test expected str_value = Alcotest.( check bool @@ -123,12 +119,8 @@ let mixed_paired_intersect () = ; pair_filter inc (exact "b") (contains "b") ] in - let pair_of_keyed_a value = - `Pair (`Key (`String "a"), `Value (`String value)) - in - let pair_of_keyed_b value = - `Pair (`Key (`String "b"), `Value (`String value)) - in + let pair_of_keyed_a value = ("a", String value) in + let pair_of_keyed_b value = ("b", String value) in let make_test expected a_value b_value = Alcotest.( check bool From c23377472bc2fb18434fc48420e29bc27f910112 Mon Sep 17 00:00:00 2001 From: Paul Monson Date: Sun, 7 Jan 2024 10:01:41 -0600 Subject: [PATCH 11/12] Better split of string and number --- .github/workflows/workflow.yml | 4 +- compiler/ast.ml | 48 ++++--------------- compiler/ast.mli | 24 ++++------ compiler/match_in_order.ml | 82 +++------------------------------ compiler/match_in_order.mli | 10 ---- compiler/match_number.ml | 32 +++++++++++++ compiler/match_number.mli | 29 ++++++++++++ compiler/match_string.ml | 66 ++++++++++++++++++++++++++ compiler/match_string.mli | 25 ++++++++++ compiler/predicate.ml | 2 +- compiler_test/predicate_test.ml | 2 +- 11 files changed, 180 insertions(+), 144 deletions(-) create mode 100644 compiler/match_number.ml create mode 100644 compiler/match_number.mli create mode 100644 compiler/match_string.ml create mode 100644 compiler/match_string.mli diff --git a/.github/workflows/workflow.yml b/.github/workflows/workflow.yml index f0e787e..e1b95b5 100644 --- a/.github/workflows/workflow.yml +++ b/.github/workflows/workflow.yml @@ -7,12 +7,12 @@ name: Main workflow jobs: build: strategy: - fail-fast: false + fail-fast: true matrix: os: - ubuntu-latest ocaml-version: - - 4.13.1 + - 5.0.0 runs-on: ${{ matrix.os }} diff --git a/compiler/ast.ml b/compiler/ast.ml index fdc7f54..3080ff8 100644 --- a/compiler/ast.ml +++ b/compiler/ast.ml @@ -3,41 +3,11 @@ type match_operation_result = | Exclude [@@deriving show, eq] -type match_type = - | String of string - | Int of int - | Float of float - -module Number = struct - type t = string * int * float option [@@deriving show, ord] - - let equal (_, i1, rf1) (_, i2, rf2) = i1 = i2 && rf1 = rf2 - let of_int i = (string_of_int i, i, None) - - let of_float f = - if Float.is_integer f then (Float.to_string f, Float.to_int f, None) - else (Float.to_string f, Float.to_int f, Some (f -. Float.trunc f)) - - let of_string s = - let _, i, rf = of_float @@ Float.of_string s in - (String.trim s, i, rf) -end - -type string_match_operation = - | ExactString of string - | ContainsString of string list - | BeginsWithString of string list - | EndsWithString of string list -[@@deriving show, eq] - -type number = Number.t [@@deriving show, eq, ord] - -type number_match_operation = - | ExactNumber of number - | LessThanNumber of number - | GreaterThanNumber of number - | BetweenNumber of number * number -[@@deriving show, eq] +type match_type = .. +type match_type += String of string | Int of int | Float of float +type string_match_operation = Match_string.op [@@deriving show, eq] +type number = Match_number.t [@@deriving show, eq, ord] +type number_match_operation = Match_number.op [@@deriving show, eq] type match_operation = | StringOp of string_match_operation @@ -84,10 +54,10 @@ let is_exclude = function | PairFilter (Exclude, _, _) -> true | _ -> false -let number_of_int = Number.of_int -let number_of_float = Number.of_float -let number_of_string = Number.of_string -let number_comp = Number.compare +let number_of_int = Match_number.T.of_int +let number_of_float = Match_number.T.of_float +let number_of_string = Match_number.T.of_string +let number_comp = Match_number.T.compare let number_op op = NumberOp op let exact_of_num num = number_op (ExactNumber num) let exact_of_int num = num |> number_of_int |> exact_of_num diff --git a/compiler/ast.mli b/compiler/ast.mli index 70e5f43..c94016b 100644 --- a/compiler/ast.mli +++ b/compiler/ast.mli @@ -14,28 +14,20 @@ type match_operation_result = | Include | Exclude -type number = string * int * float option +type number = Match_number.t +val pp_number : Format.formatter -> number -> unit +val show_number : number -> string val equal_number : number -> number -> bool val compare_number : number -> number -> int -type match_type = - | String of string - | Int of int - | Float of float +type match_type = .. +type match_type += String of string | Int of int | Float of float +type string_match_operation = Match_string.op (** The type of operation to use in the the filter *) -type string_match_operation = - | ExactString of string - | ContainsString of string list - | BeginsWithString of string list - | EndsWithString of string list - -type number_match_operation = - | ExactNumber of number - | LessThanNumber of number - | GreaterThanNumber of number - | BetweenNumber of number * number + +type number_match_operation = Match_number.op type match_operation = | StringOp of string_match_operation diff --git a/compiler/match_in_order.ml b/compiler/match_in_order.ml index 2ec77f2..f1cd2e1 100644 --- a/compiler/match_in_order.ml +++ b/compiler/match_in_order.ml @@ -1,84 +1,16 @@ -let match_in_order_acc ~comp ~subs:sub_list to_check = - let open CCString in - let init_acc = (false, 0) in - let is_in_order acc to_find = - match acc with - | false, left when left != 0 -> (false, left) - | _, idx -> - let found = find ~start:idx ~sub:to_find to_check in - let is_found = comp found idx in - let next_idx = - if is_found then found + length to_find else idx + length to_find - in - (is_found, next_idx) - in - List.fold_left is_in_order init_acc sub_list - -let fst input = match input with b, _ -> b - -let match_in_order ~comp ~subs to_check = - match_in_order_acc ~comp ~subs to_check |> fst - -let contains_in_order ~subs string_to_check = - match_in_order ~comp:(fun found _ -> found != -1) ~subs string_to_check - -let begins_with_in_order ~subs string_to_check = - match_in_order ~comp:(fun found idx -> found == idx) ~subs string_to_check - -let ends_with_in_order ~subs to_check = - begins_with_in_order - ~subs:(List.rev subs |> List.map CCString.rev) - (CCString.rev to_check) - -let string_match_operation (from_input : string) - (match_op : Ast.string_match_operation) : bool = - let open CCString in - match match_op with - | ExactString expected -> - equal - (String.lowercase_ascii from_input) - (String.lowercase_ascii expected) - | ContainsString subs -> - contains_in_order - ~subs:(List.map String.lowercase_ascii subs) - (String.lowercase_ascii from_input) - | BeginsWithString subs -> - begins_with_in_order - ~subs:(List.map String.lowercase_ascii subs) - (String.lowercase_ascii from_input) - | EndsWithString subs -> - ends_with_in_order - ~subs:(List.map String.lowercase_ascii subs) - (String.lowercase_ascii from_input) - -let number_match_operation (from_input : Ast.number) - (match_op : Ast.number_match_operation) : bool = - match match_op with - | ExactNumber expected -> Ast.number_comp from_input expected == 0 - | Ast.LessThanNumber lower -> Ast.number_comp lower from_input == 1 - | Ast.GreaterThanNumber upper -> Ast.number_comp from_input upper == 1 - | Ast.BetweenNumber (lower, upper) -> - Ast.number_comp from_input upper == -1 - && Ast.number_comp lower from_input == -1 - let match_operation (typed_from_input : Ast.match_type) (op : Ast.match_operation) : bool = match typed_from_input with - | String s -> ( + | Ast.String s -> ( match Ast.string_op_of_op op with - | Some string_op -> string_match_operation s string_op + | Some string_op -> Match_string.check_match s string_op | None -> false) - | Int i -> ( + | Ast.Int i -> ( match Ast.number_op_of_op op with - | Some num_op -> number_match_operation (Ast.number_of_int i) num_op + | Some num_op -> Match_number.check_match (Ast.number_of_int i) num_op | None -> false) - | Float f -> ( + | Ast.Float f -> ( match Ast.number_op_of_op op with - | Some num_op -> number_match_operation (Ast.number_of_float f) num_op + | Some num_op -> Match_number.check_match (Ast.number_of_float f) num_op | None -> false) - -module T = struct - type t = string [@@deriving show] - - let equal = CCString.equal -end + | _ -> false diff --git a/compiler/match_in_order.mli b/compiler/match_in_order.mli index d13c88c..4bcb419 100644 --- a/compiler/match_in_order.mli +++ b/compiler/match_in_order.mli @@ -1,11 +1 @@ val match_operation : Ast.match_type -> Ast.match_operation -> bool -val string_match_operation : string -> Ast.string_match_operation -> bool -val number_match_operation : Ast.number -> Ast.number_match_operation -> bool - -module T : sig - type t = string - - val pp : Format.formatter -> t -> unit - val show : t -> string - val equal : t -> t -> bool -end diff --git a/compiler/match_number.ml b/compiler/match_number.ml new file mode 100644 index 0000000..1282f02 --- /dev/null +++ b/compiler/match_number.ml @@ -0,0 +1,32 @@ +module T = struct + type t = string * int * float option [@@deriving show] + + let equal (_, i1, rf1) (_, i2, rf2) = i1 = i2 && rf1 = rf2 + let compare (_, i1, rf1) (_, i2, rf2) = compare (i1, rf1) (i2, rf2) + let of_int i = (string_of_int i, i, None) + + let of_float f = + if Float.is_integer f then (Float.to_string f, Float.to_int f, None) + else (Float.to_string f, Float.to_int f, Some (f -. Float.trunc f)) + + let of_string s = + let _, i, rf = of_float @@ Float.of_string s in + (String.trim s, i, rf) +end + +type t = T.t [@@deriving show, eq, ord] + +type op = + | ExactNumber of t + | LessThanNumber of t + | GreaterThanNumber of t + | BetweenNumber of t * t +[@@deriving show, eq] + +let check_match (from_input : t) (match_op : op) : bool = + match match_op with + | ExactNumber expected -> T.compare from_input expected == 0 + | LessThanNumber lower -> T.compare lower from_input == 1 + | GreaterThanNumber upper -> T.compare from_input upper == 1 + | BetweenNumber (lower, upper) -> + T.compare from_input upper == -1 && T.compare lower from_input == -1 diff --git a/compiler/match_number.mli b/compiler/match_number.mli new file mode 100644 index 0000000..0820a7c --- /dev/null +++ b/compiler/match_number.mli @@ -0,0 +1,29 @@ +module T : sig + type t + + val pp : Format.formatter -> t -> unit + val show : t -> string + val equal : t -> t -> bool + val compare : t -> t -> int + val of_int : int -> t + val of_float : float -> t + val of_string : string -> t +end + +type t = T.t + +val pp : Format.formatter -> t -> unit +val show : t -> string +val equal : t -> t -> bool +val compare : t -> t -> int + +type op = + | ExactNumber of t + | LessThanNumber of t + | GreaterThanNumber of t + | BetweenNumber of t * t + +val pp_op : Format.formatter -> op -> unit +val show_op : op -> string +val equal_op : op -> op -> bool +val check_match : t -> op -> bool diff --git a/compiler/match_string.ml b/compiler/match_string.ml new file mode 100644 index 0000000..b45694a --- /dev/null +++ b/compiler/match_string.ml @@ -0,0 +1,66 @@ +module T = struct + type t = string [@@deriving show, ord] + + let equal = CCString.equal +end + +type t = T.t [@@deriving show, eq, ord] + +type op = + | ExactString of string + | ContainsString of string list + | BeginsWithString of string list + | EndsWithString of string list +[@@deriving show, eq] + +let match_in_order_acc ~comp ~subs:sub_list to_check = + let open CCString in + let init_acc = (false, 0) in + let is_in_order acc to_find = + match acc with + | false, left when left != 0 -> (false, left) + | _, idx -> + let found = find ~start:idx ~sub:to_find to_check in + let is_found = comp found idx in + let next_idx = + if is_found then found + length to_find else idx + length to_find + in + (is_found, next_idx) + in + List.fold_left is_in_order init_acc sub_list + +let fst input = match input with b, _ -> b + +let match_in_order ~comp ~subs to_check = + match_in_order_acc ~comp ~subs to_check |> fst + +let contains_in_order ~subs string_to_check = + match_in_order ~comp:(fun found _ -> found != -1) ~subs string_to_check + +let begins_with_in_order ~subs string_to_check = + match_in_order ~comp:(fun found idx -> found == idx) ~subs string_to_check + +let ends_with_in_order ~subs to_check = + begins_with_in_order + ~subs:(List.rev subs |> List.map CCString.rev) + (CCString.rev to_check) + +let check_match (from_input : string) (match_op : op) : bool = + let open CCString in + match match_op with + | ExactString expected -> + equal + (String.lowercase_ascii from_input) + (String.lowercase_ascii expected) + | ContainsString subs -> + contains_in_order + ~subs:(List.map String.lowercase_ascii subs) + (String.lowercase_ascii from_input) + | BeginsWithString subs -> + begins_with_in_order + ~subs:(List.map String.lowercase_ascii subs) + (String.lowercase_ascii from_input) + | EndsWithString subs -> + ends_with_in_order + ~subs:(List.map String.lowercase_ascii subs) + (String.lowercase_ascii from_input) diff --git a/compiler/match_string.mli b/compiler/match_string.mli new file mode 100644 index 0000000..ef3003e --- /dev/null +++ b/compiler/match_string.mli @@ -0,0 +1,25 @@ +module T : sig + type t = string + + val pp : Format.formatter -> t -> unit + val show : t -> string + val equal : t -> t -> bool +end + +type t = T.t + +val pp : Format.formatter -> t -> unit +val show : t -> string +val equal : t -> t -> bool +val compare : t -> t -> int + +type op = + | ExactString of string + | ContainsString of string list + | BeginsWithString of string list + | EndsWithString of string list + +val pp_op : Format.formatter -> op -> unit +val show_op : op -> string +val equal_op : op -> op -> bool +val check_match : t -> op -> bool diff --git a/compiler/predicate.ml b/compiler/predicate.ml index 42fa8cc..eaa85ae 100644 --- a/compiler/predicate.ml +++ b/compiler/predicate.ml @@ -2,7 +2,7 @@ type pair = string * Ast.match_type let invert = Bool.not let match_operation ~match_fun op (m : Ast.match_type) : bool = match_fun m op -let match_type_of_string str : Ast.match_type = String str +let match_type_of_string str : Ast.match_type = Ast.String str let key_match_operation ~match_fun op (k : string) : bool = match_operation ~match_fun op @@ match_type_of_string k diff --git a/compiler_test/predicate_test.ml b/compiler_test/predicate_test.ml index e868a69..1aad96a 100644 --- a/compiler_test/predicate_test.ml +++ b/compiler_test/predicate_test.ml @@ -1,6 +1,6 @@ let test_name = "Predicate" let match_fun = Fex_compiler__Match_in_order.match_operation -let string_pp = Fex_compiler__Match_in_order.T.pp +let string_pp = Fex_compiler__Match_string.pp let filter_to_bool to_check with_filter = Fex_compiler__Predicate.filter_to_predicate ~match_fun to_check with_filter From e9a164884d28666bd053044ee77096739e83b5fa Mon Sep 17 00:00:00 2001 From: Paul Monson Date: Sun, 7 Jan 2024 10:36:28 -0600 Subject: [PATCH 12/12] remove number from the combiner keys are always assumed as strings, we only combine on keys --- compiler/combiner.ml | 28 ++++------------------------ 1 file changed, 4 insertions(+), 24 deletions(-) diff --git a/compiler/combiner.ml b/compiler/combiner.ml index a9177e4..dcb41e5 100644 --- a/compiler/combiner.ml +++ b/compiler/combiner.ml @@ -11,14 +11,8 @@ type t = | ExcludePairGroupContainsString of string list | ExcludePairGroupBeginsWithString of string list | ExcludePairGroupEndsWithString of string list - | IncludePairGroupExactNumber of Ast.number - | IncludePairGroupLessThanNumber of Ast.number - | IncludePairGroupGreaterThanNumber of Ast.number - | IncludePairGroupBetweenNumber of Ast.number * Ast.number - | ExcludePairGroupExactNumber of Ast.number - | ExcludePairGroupLessThanNumber of Ast.number - | ExcludePairGroupGreaterThanNumber of Ast.number - | ExcludePairGroupBetweenNumber of Ast.number * Ast.number + | IncludeOther + | ExcludeOther [@@deriving eq] let as_group a b = @@ -45,22 +39,8 @@ let as_group a b = ExcludePairGroupBeginsWithString keys | PairFilter (Exclude, StringOp (EndsWithString keys), _) -> ExcludePairGroupEndsWithString keys - | PairFilter (Include, NumberOp (ExactNumber num), _) -> - IncludePairGroupExactNumber num - | PairFilter (Include, NumberOp (LessThanNumber num), _) -> - IncludePairGroupLessThanNumber num - | PairFilter (Include, NumberOp (GreaterThanNumber num), _) -> - IncludePairGroupGreaterThanNumber num - | PairFilter (Include, NumberOp (BetweenNumber (bottom, top)), _) -> - IncludePairGroupBetweenNumber (bottom, top) - | PairFilter (Exclude, NumberOp (ExactNumber num), _) -> - ExcludePairGroupExactNumber num - | PairFilter (Exclude, NumberOp (LessThanNumber num), _) -> - ExcludePairGroupLessThanNumber num - | PairFilter (Exclude, NumberOp (GreaterThanNumber num), _) -> - ExcludePairGroupGreaterThanNumber num - | PairFilter (Exclude, NumberOp (BetweenNumber (bottom, top)), _) -> - ExcludePairGroupBetweenNumber (bottom, top) + | PairFilter (Include, _, _) -> IncludeOther + | PairFilter (Exclude, _, _) -> ExcludeOther in let category_a = categorize a in let category_b = categorize b in