├── .gitignore ├── .merlin ├── .ocamlformat ├── .travis.yml ├── CHANGES.md ├── LICENSE ├── README.md ├── bench ├── Dedup.json ├── Reverse.json ├── add.json ├── append.json ├── appendt.json ├── concat.json ├── count_leaves.json ├── count_nodes.json ├── cprod.json ├── droplast.json ├── dropmax.json ├── dropmins.json ├── dupli.json ├── evens.json ├── flatten.json ├── flattenl.json ├── height.json ├── incrs.json ├── incrt.json ├── insertn.json ├── intersect.json ├── join.json ├── largest_n.json ├── last.json ├── leaves.json ├── length.json ├── max.json ├── maxt.json ├── member.json ├── membert.json ├── multfirst.json ├── multlast.json ├── prependt.json ├── replacet.json ├── searchnodes.json ├── selectnodes.json ├── shiftl.json ├── shiftr.json ├── sum.json ├── sumnodes.json ├── sums.json ├── sumt.json ├── sumtrees.json └── tconcat.json ├── bin ├── benchmark.py ├── dune ├── example_gen.py ├── generate_functions.ml ├── generate_values.ml └── l2_cli.ml ├── components ├── list.ml └── stdlib.ml ├── default_cost.json ├── dune ├── dune-project ├── l2.opam ├── l2.opam.locked ├── lib ├── ast.ml ├── automaton.ml ├── collections.ml ├── combinat.ml ├── combinat.mli ├── config.ml ├── config.mli ├── dune ├── eval.ml ├── eval.mli ├── example.ml ├── example.mli ├── example_deduction.ml ├── example_deduction.mli ├── expr.ml ├── exprValue.ml ├── exprValue.mli ├── fast_example_deduction.ml ├── generate_functions.ml ├── higher_order_deduction.ml ├── higher_order_deduction.mli ├── hypothesis.ml ├── hypothesis.mli ├── infer.ml ├── infer.mli ├── input_deduction.ml ├── input_deduction.mli ├── lexer_ml.mll ├── lexer_sexp.mll ├── library.ml ├── library.mli ├── parser_ml.mly ├── parser_sexp.mly ├── random_deduction.ml ├── random_deduction.mli ├── recursive_spec_deduction.ml ├── rewrite.ml ├── sstream.ml ├── status.ml ├── status.mli ├── structure.ml ├── symbolic_execution.ml ├── synthesis_common.ml ├── synthesis_common.mli ├── testcase.ml ├── testcase.mli ├── unify.ml ├── util.ml ├── v1_engine.ml ├── v1_engine.mli ├── v1_solver_engine.ml ├── v1_solver_engine.mli ├── v2_engine.ml ├── v2_engine.mli ├── value.ml ├── value.mli └── verify.ml ├── paramils ├── crossvalidate.py ├── instances.txt ├── l2_wrapper.py ├── params.txt └── scenario.txt └── test ├── collections_tests.ml ├── dune ├── eval_tests.ml ├── hypothesis_tests.ml ├── sexp_parser_tests.ml ├── tests.ml ├── tests_common.ml ├── type_tests.ml ├── unify_tests.ml └── v2_engine_tests.ml /.gitignore: -------------------------------------------------------------------------------- 1 | # ========================= 2 | # Ocaml build files 3 | # ========================= 4 | 5 | *.cm[iotx] 6 | *.annot 7 | *.o 8 | *.native 9 | *.byte 10 | *.depends 11 | _build/ 12 | setup.data 13 | setup.log 14 | 15 | .merlin 16 | *.install 17 | -------------------------------------------------------------------------------- /.merlin: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jfeser/L2/053b59c789967e16bdc761c17a61f86e2a4a4e4c/.merlin -------------------------------------------------------------------------------- /.ocamlformat: -------------------------------------------------------------------------------- 1 | margin = 85 2 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: c 2 | sudo: required 3 | install: wget https://raw.githubusercontent.com/ocaml/ocaml-ci-scripts/master/.travis-opam.sh 4 | script: bash -ex .travis-opam.sh 5 | env: 6 | - OCAML_VERSION=4.06 PACKAGE="l2" 7 | os: 8 | - linux 9 | - osx 10 | -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | ## 2.0 (2019-02-01) 2 | 3 | Initial release. 4 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # λ² [![Build Status](https://travis-ci.org/jfeser/L2.svg?branch=master)](https://travis-ci.org/jfeser/L2) 2 | λ² is a tool for synthesizing functional programs from input-output examples. 3 | 4 | There are two versions of λ²: 5 | - *PLDI:* This is a slightly improved version of the code that we benchmarked for the PLDI 2015 paper. **Use this if you want to reproduce our benchmarks.** 6 | - *Development:* This version has significantly diverged and no longer performs similarly. However, it has many more features and the code is cleaner. **Use this if you want to extend λ².** 7 | 8 | ## Building 9 | 10 | 1. Clone the repository: 11 | 12 | ``` shell 13 | git clone git@github.com:jfeser/L2.git; cd L2 14 | ``` 15 | 16 | 2. Install dependencies. 17 | 18 | ``` shell 19 | opam install --deps-only ./l2.opam.locked 20 | ``` 21 | 22 | ### PLDI version 23 | 24 | 2. Check out the `pldi-modernize` branch. 25 | 26 | ``` shell 27 | git checkout pldi-modernize 28 | ``` 29 | 30 | 4. Try λ² on a benchmark problem by running: 31 | 32 | ```shell 33 | dune exec src/l2.exe -- benchmarks/concat.json 34 | ``` 35 | 36 | You should see output like: 37 | 38 | ``` text 39 | Solved concat in 39ms. Solutions: 40 | (let concat (let a (lambda (c b) (foldr c (lambda (e d) (cons d e)) b)) _) _) 41 | ``` 42 | 43 | ### Development version 44 | 45 | 3. Try λ² on a benchmark problem by running: 46 | 47 | ```shell 48 | dune exec src/l2-cli/l2_cli.exe -- synth -l components/stdlib.ml -dd higher_order,input_ctx specs/largest_n.json 49 | ``` 50 | 51 | You should see output like: 52 | 53 | ``` text 54 | .lkO0K0xc. 55 | 'kk;. .;kWXc Synthesizing.. 56 | .NN, kMMo 57 | 'WMWx kMMk Hypotheses verified: 48458 58 | ;dkc lWMX, Hypotheses saved: 0 59 | .:loc. .OMWx. 60 | .okcdWMN, .oXOc. Memoization table hit rate: 98.16 61 | .0o kMM0 .xNk' '; 62 | .' lMMN. .cOl. .KO Hashcons table equals calls: 1139934 (718173 t, 421761 f) 63 | ;MMM, lXWOddddddx0Md Hashcons table hash calls: 891626, hashcons calls: 891626 64 | oMMM: ;kkkkkkkkkkkkk, Hashcons table len: 73738, num entries: 69923 65 | .ONWMMl Hashcons bucket sum: 160341, min: 0, med: 3, max: 21 66 | 'XO.0MMo 67 | ,Ko OMMx Signatures: 2785 none, 25306 checked, 18420 dups, 0 fails 68 | .xNc xMMO 69 | ;NK, dMM0 70 | .dNd. lMMX. .. 71 | ;XMo :MMM' ,O. 72 | dWNl .NMMOlxd. 73 | lKO: ;KMNx. 74 | Runtime: 5.4s 75 | Found solution: 76 | fun b a -> take (reverse (sort (concat a))) b 77 | ``` 78 | 79 | ## Running benchmarks 80 | 81 | Benchmark problems are in the `bench/` directory. 82 | 83 | ## Questions? 84 | 85 | Send email to feser@csail.mit.edu. 86 | 87 | ## Publications 88 | 89 | Feser, J. K., Chaudhuri, S., & Dillig, I. (2015, June). [Synthesizing data structure transformations from input-output examples.](http://dl.acm.org/citation.cfm?id=2737977) In Proceedings of the 36th ACM SIGPLAN Conference on Programming Language Design and Implementation (pp. 229-239). ACM. 90 | -------------------------------------------------------------------------------- /bench/Dedup.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "Dedup", 3 | "description": 4 | "Removes duplicate elements from a list. Requires the specification of $member$.", 5 | "kind": "examples", 6 | "blacklist": ["dedup"], 7 | "contents": { 8 | "examples": [ 9 | "(Dedup []) -> []", "(Dedup [1]) -> [1]", "(Dedup [1 2 5]) -> [1 2 5]", 10 | "(Dedup [1 2 5 2]) -> [1 5 2]", "(Dedup [1 1 1 2 5 2]) -> [1 5 2]", 11 | "(Dedup [3 3 3 5 5 5]) -> [3 5]", "(Dedup [1 2 3 2 1]) -> [3 2 1]" 12 | ], 13 | "background": [ 14 | [ 15 | "member", "(lambda (b a) (foldl b (lambda (d c) (| d (= a c))) #f))" 16 | ] 17 | ] 18 | } 19 | } 20 | -------------------------------------------------------------------------------- /bench/Reverse.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "Reverse", 3 | "description": "Reverses a list.", 4 | "kind": "examples", 5 | "blacklist": ["reverse"], 6 | "contents": { 7 | "examples": [ 8 | "(Reverse []) -> []", 9 | "(Reverse [0]) -> [0]", 10 | "(Reverse [0 1]) -> [1 0]", 11 | "(Reverse [0 2 1]) -> [1 2 0]" 12 | ], 13 | "background": [] 14 | } 15 | } 16 | -------------------------------------------------------------------------------- /bench/add.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "add", 3 | "description": 4 | "Adds a number to each element of a list.", 5 | "kind": "examples", 6 | "contents": { 7 | "examples": [ 8 | "(add [] 1) -> []", 9 | "(add [1 2] 5) -> [6 7]", 10 | "(add [1 2] 2) -> [3 4]", 11 | "(add [1 2 3 4] 5) -> [6 7 8 9]" 12 | ], 13 | "background": [] 14 | } 15 | } 16 | -------------------------------------------------------------------------------- /bench/append.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "Append", 3 | "description": "Appends an item to a list.", 4 | "kind": "examples", 5 | "contents": { 6 | "examples": [ 7 | "(Append [] 1) -> [1]", 8 | "(Append [] 2) -> [2]", 9 | "(Append [1 2 3 4] 1) -> [1 2 3 4 1]" 10 | ], 11 | "background": [] 12 | } 13 | } 14 | -------------------------------------------------------------------------------- /bench/appendt.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "appendt", 3 | "description": "", 4 | "kind": "examples", 5 | "contents": { 6 | "examples": [ 7 | "(appendt {[]} 1) -> {[1]}", "(appendt {[]} 2) -> {[2]}", 8 | "(appendt {[1 2 3]} 1) -> {[1 2 3 1]}", 9 | "(appendt {[1 2 3] {[3 4]}} 1) -> {[1 2 3 1] {[3 4 1]}}", 10 | "(appendt {[1 2 3] {[3 4]} {[5 6]}} 7) -> {[1 2 3 7] {[3 4 7]} {[5 6 7]}}" 11 | ], 12 | "background": [] 13 | } 14 | } -------------------------------------------------------------------------------- /bench/concat.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "concat", 3 | "description": "Appends a list to the end of another list.", 4 | "kind": "examples", 5 | "contents": { 6 | "examples": [ 7 | "(concat [] []) -> []", 8 | "(concat [0] []) -> [0]", 9 | "(concat [] [0]) -> [0]", 10 | "(concat [1 0] [0]) -> [1 0 0]", 11 | "(concat [1 0 2] [3 4]) -> [1 0 2 3 4]" 12 | ], 13 | "background": [] 14 | } 15 | } 16 | -------------------------------------------------------------------------------- /bench/count_leaves.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "count_leaves", 3 | "description": "Counts the number of leaves in a tree.", 4 | "kind": "examples", 5 | "contents": { 6 | "examples": [ 7 | "(count_leaves {}) -> 0", "(count_leaves {5}) -> 1", 8 | "(count_leaves {3 {2}}) -> 1", "(count_leaves {3 {2} {5}}) -> 2", 9 | "(count_leaves {3 {2 {3}} {5}}) -> 2", 10 | "(count_leaves {3 {2 {3} {5}} {5 {5}}}) -> 3", 11 | "(count_leaves {3 {2 {3} {5}} {5 {5} {4}}}) -> 4", 12 | "(count_leaves {5 {5 {5 {5 {5 {5 {5 {5}}}}}}}}) -> 1" 13 | ], 14 | "background": [ 15 | [ "sum", "(lambda (a) (foldl a (lambda (c b) (+ c b)) 0))" ] 16 | ] 17 | } 18 | } -------------------------------------------------------------------------------- /bench/count_nodes.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "count_nodes", 3 | "description": "", 4 | "kind": "examples", 5 | "contents": { 6 | "examples": [ 7 | "(count_nodes {}) -> 0", "(count_nodes {2}) -> 1", 8 | "(count_nodes {2 {3} {4}}) -> 3", 9 | "(count_nodes {2 {3 {0}} {4 {9} {8}}}) -> 6" 10 | ], 11 | "background": [] 12 | } 13 | } -------------------------------------------------------------------------------- /bench/cprod.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "cprod", 3 | "description": "", 4 | "kind": "examples", 5 | "contents": { 6 | "examples": [ 7 | "(f []) -> [[]]", "(f [[]]) -> []", "(f [[] []]) -> []", 8 | "(f [[1 2 3] [4] [5 6]]) -> [[1 4 5] [1 4 6] [2 4 5] [2 4 6] [3 4 5] [3 4 6]]" 9 | ], 10 | "background": [] 11 | } 12 | } -------------------------------------------------------------------------------- /bench/droplast.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "droplast", 3 | "description": "", 4 | "kind": "examples", 5 | "contents": { 6 | "examples": [ 7 | "(droplast [1]) -> []", "(droplast [1 2 3]) -> [1 2]", 8 | "(droplast [1 2]) -> [1]", "(droplast [1 5 2 7 8]) -> [1 5 2 7]", 9 | "(droplast [1 1 1 1 1 1 1]) -> [1 1 1 1 1 1]", 10 | "(droplast [1 1 1 1 1 1]) -> [1 1 1 1 1]", 11 | "(droplast [1 0 1]) -> [1 1]" 12 | ], 13 | "background": [] 14 | } 15 | } 16 | -------------------------------------------------------------------------------- /bench/dropmax.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "dropmax", 3 | "description": 4 | "Removes the largest number in a list. Requires the specification of $max$.", 5 | "kind": "examples", 6 | "contents": { 7 | "examples": [ 8 | "(dropmax [3 5 2]) -> [3 2]", "(dropmax [3 1 2]) -> [1 2]", 9 | "(dropmax [1 5 2]) -> [1 2]" 10 | ], 11 | "background": [] 12 | } 13 | } -------------------------------------------------------------------------------- /bench/dropmins.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "dropmins", 3 | "description": "", 4 | "kind": "examples", 5 | "contents": { 6 | "examples": [ 7 | "(dropmins []) -> []", "(dropmins [[1]]) -> [[]]", 8 | "(dropmins [[1 3 5] [5 3 2]]) -> [[3 5] [5 3]]", 9 | "(dropmins [[8 4 7 2] [4 6 2 9] [3 4 1 0]]) -> [[8 4 7] [4 6 9] [3 4 1]]" 10 | ], 11 | "background": [ 12 | [ "min", "(lambda (a) (foldl a (lambda (c b) (if (< c b) c b)) inf))" ] 13 | ] 14 | } 15 | } -------------------------------------------------------------------------------- /bench/dupli.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "dupli", 3 | "description": "Duplicates each element in a list.", 4 | "kind": "examples", 5 | "contents": { 6 | "examples": [ 7 | "(dupli []) -> []", "(dupli [1]) -> [1 1]", 8 | "(dupli [1 2 3]) -> [1 1 2 2 3 3]" 9 | ], 10 | "background": [] 11 | } 12 | } -------------------------------------------------------------------------------- /bench/evens.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "evens", 3 | "description": 4 | "Filters out the odd numbers in a list, leaving the even numbers.", 5 | "kind": "examples", 6 | "contents": { 7 | "examples": [ 8 | "(evens []) -> []", "(evens [1]) -> []", "(evens [1 2]) -> [2]", 9 | "(evens [1 2 3 4]) -> [2 4]", "(evens [5 6 3 9 8 4]) -> [6 8 4]" 10 | ], 11 | "background": [] 12 | } 13 | } -------------------------------------------------------------------------------- /bench/flatten.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "flatten", 3 | "description": 4 | "Flattens a tree into a list. Requires the specification of $join$.", 5 | "kind": "examples", 6 | "contents": { 7 | "examples": [ 8 | "(flatten {}) -> []", "(flatten {1}) -> [1]", 9 | "(flatten {1 {2} {3}}) -> [1 2 3]" 10 | ], 11 | "background": [ 12 | [ 13 | "join", 14 | "(lambda (a) (foldl a (lambda (c b) (foldr c (lambda (e d) (cons d e)) b)) []))" 15 | ] 16 | ] 17 | } 18 | } -------------------------------------------------------------------------------- /bench/flattenl.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "flattenl", 3 | "description": 4 | "Flattens a tree of lists into a list. Requires the specification of $join$.", 5 | "kind": "examples", 6 | "contents": { 7 | "examples": [ 8 | "(flattenl {}) -> []", "(flattenl {[1]}) -> [1]", 9 | "(flattenl {[1] {[2]} {[3]}}) -> [1 2 3]", 10 | "(flattenl {[1 1 1] {[2]} {[3]}}) -> [1 1 1 2 3]", 11 | "(flattenl {[1 1 1] {[2 5 7]} {[3]}}) -> [1 1 1 2 5 7 3]" 12 | ], 13 | "background": [ 14 | [ 15 | "join", 16 | "(lambda (a) (foldl a (lambda (c b) (foldr c (lambda (e d) (cons d e)) b)) []))" 17 | ] 18 | ] 19 | } 20 | } -------------------------------------------------------------------------------- /bench/height.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "height", 3 | "description": 4 | "Returns the height of a tree. Requires the specification of $max$.", 5 | "kind": "examples", 6 | "contents": { 7 | "examples": [ 8 | "(height {}) -> 0", "(height {1}) -> 1", 9 | "(height {100 {100} {100}}) -> 2", 10 | "(height {100 {100} {100 {100 {100}}}}) -> 4", 11 | "(height {100 {100 {100 {100 {100}}}} {100}}) -> 5", 12 | "(height {90 {6 {5} {6} {8}} {7} {9} {5}}) -> 3" 13 | ], 14 | "background": [ 15 | [ "max", "(lambda (a) (foldl a (lambda (c b) (if (< c b) b c)) 0))" ] 16 | ] 17 | } 18 | } -------------------------------------------------------------------------------- /bench/incrs.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "incrs", 3 | "description": 4 | "For each list in a list of lists, increments each number in the list by one.", 5 | "kind": "examples", 6 | "contents": { 7 | "examples": [ 8 | "(incrs []) -> []", "(incrs [[1]]) -> [[2]]", 9 | "(incrs [[1] [2]]) -> [[2] [3]]", 10 | "(incrs [[1 2] [3 4]]) -> [[2 3] [4 5]]" 11 | ], 12 | "background": [] 13 | } 14 | } -------------------------------------------------------------------------------- /bench/incrt.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "incrt", 3 | "description": "Increments the value of each node in a tree by one.", 4 | "kind": "examples", 5 | "contents": { 6 | "examples": [ 7 | "(incrt {}) -> {}", "(incrt {1}) -> {2}", "(incrt {1 {2}}) -> {2 {3}}" 8 | ], 9 | "background": [] 10 | } 11 | } -------------------------------------------------------------------------------- /bench/insertn.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "insertn", 3 | "description": "", 4 | "kind": "examples", 5 | "contents": { 6 | "examples": [ 7 | "(insertn [] 0 1) -> [1]", "(insertn [3 4] 0 2) -> [2 3 4]", 8 | "(insertn [3 4] 1 2) -> [3 2 4]", "(insertn [3 4] 2 2) -> [3 4 2]" 9 | ], 10 | "background": [] 11 | } 12 | } -------------------------------------------------------------------------------- /bench/intersect.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "intersect", 3 | "description": "", 4 | "kind": "examples", 5 | "contents": { 6 | "examples": [ 7 | "(intersect [2 3 1] [5 3 4]) -> [3]", 8 | "(intersect [2 3 1] [3 5 4]) -> [3]", 9 | "(intersect [2 3 8] [3 5 8]) -> [3 8]", 10 | "(intersect [1 2 3 0] [3 1 0 9]) -> [0 1 3]" 11 | ], 12 | "background": [] 13 | } 14 | } -------------------------------------------------------------------------------- /bench/join.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "join", 3 | "description": "Concatenates together a list of lists.", 4 | "kind": "examples", 5 | "blacklist": ["concat", "append"], 6 | "contents": { 7 | "examples": [ 8 | "(join []) -> []", "(join [[] [1 0]]) -> [1 0]", 9 | "(join [[1 0] []]) -> [1 0]", 10 | "(join [[1 0] [2 3] [6] [4 5]]) -> [1 0 2 3 6 4 5]" 11 | ], 12 | "background": [] 13 | } 14 | } 15 | -------------------------------------------------------------------------------- /bench/largest_n.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "largest_n", 3 | "description": "", 4 | "kind": "examples", 5 | "contents": { 6 | "examples": [ 7 | "(largest_n 3 [[1 2 3] [3 4] [3 2 7]]) -> [7 4 3]", 8 | "(largest_n 2 [[1 2 3] [3 7] [3 2 7]]) -> [7 7]", 9 | "(largest_n 1 [[1 2 3] [3 4] [3 2 7]]) -> [7]" 10 | ], 11 | "background": [] 12 | } 13 | } -------------------------------------------------------------------------------- /bench/last.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "last", 3 | "description": "Returns the last element in a list.", 4 | "kind": "examples", 5 | "contents": { 6 | "examples": [ 7 | "(last [1]) -> 1", "(last [1 2]) -> 2", "(last [1 2 3]) -> 3", 8 | "(last [1 3 5 8]) -> 8" 9 | ], 10 | "background": [] 11 | } 12 | } -------------------------------------------------------------------------------- /bench/leaves.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "leaves", 3 | "description": "Returns a list of the leaves of a tree.", 4 | "kind": "examples", 5 | "contents": { 6 | "examples": [ 7 | "(leaves {}) -> []", "(leaves {1}) -> [1]", 8 | "(leaves {1 {2} {3}}) -> [2 3]", "(leaves {1 {2} {3 {4}}}) -> [2 4]", 9 | "(leaves {1 {2 {1} {5}} {3 {4}}}) -> [1 5 4]" 10 | ], 11 | "background": [ 12 | [ 13 | "join", 14 | "(lambda (a) (foldl a (lambda (c b) (foldr c (lambda (e d) (cons d e)) b)) []))" 15 | ] 16 | ] 17 | } 18 | } -------------------------------------------------------------------------------- /bench/length.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "length", 3 | "description": "Returns the length of a list.", 4 | "kind": "examples", 5 | "blacklist": ["len"], 6 | "contents": { 7 | "examples": [ 8 | "(length []) -> 0", "(length [0]) -> 1", "(length [0 0]) -> 2", 9 | "(length [0 2 1]) -> 3" 10 | ], 11 | "background": [] 12 | } 13 | } 14 | -------------------------------------------------------------------------------- /bench/max.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "max", 3 | "description": 4 | "Returns the largest number in a list, or zero if the list is empty.", 5 | "kind": "examples", 6 | "blacklist": ["max"], 7 | "contents": { 8 | "examples": [ 9 | "(max []) -> 0", "(max [0]) -> 0", "(max [0 2 1]) -> 2", 10 | "(max [1 6 2 5]) -> 6", "(max [1 6 7 5]) -> 7", 11 | "(max [10 25 7 9 18]) -> 25", "(max [100 25 7 9 18]) -> 100" 12 | ], 13 | "background": [] 14 | } 15 | } 16 | -------------------------------------------------------------------------------- /bench/maxt.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "maxt", 3 | "description": "Returns the maximum element in a tree.", 4 | "kind": "examples", 5 | "contents": { 6 | "examples": [ 7 | "(maxt {}) -> 0", "(maxt {1}) -> 1", "(maxt {5 {2} {3}}) -> 5", 8 | "(maxt {5 {2} {6}}) -> 6", "(maxt {5 {2 {0} {7} {4}} {6}}) -> 7", 9 | "(maxt {5 {2 {0} {7} {4}} {8}}) -> 8" 10 | ], 11 | "background": [] 12 | } 13 | } -------------------------------------------------------------------------------- /bench/member.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "member", 3 | "description": "Checks whether an item is a member of a list.", 4 | "kind": "examples", 5 | "contents": { 6 | "examples": [ 7 | "(member [] 0) -> #f", "(member [0] 0) -> #t", "(member [0] 1) -> #f", 8 | "(member [0 1 0] 0) -> #t", "(member [0 1 0] 1) -> #t", 9 | "(member [1 6 2 5] 2) -> #t", "(member [5 6 2] 6) -> #t", 10 | "(member [2 5 6] 6) -> #t", "(member [1 2 5] 3) -> #f" 11 | ], 12 | "background": [] 13 | } 14 | } -------------------------------------------------------------------------------- /bench/membert.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "membert", 3 | "description": "Checks whether an element is contained in a tree.", 4 | "kind": "examples", 5 | "contents": { 6 | "examples": [ 7 | "(membert {} 1) -> #f", "(membert {1} 1) -> #t", 8 | "(membert {0 {5} {6} {6}} 6) -> #t", 9 | "(membert {0 {5 {7} {1} {1}} {6} {8}} 3) -> #f", 10 | "(membert {0 {5 {7} {1} {3}} {6} {8}} 9) -> #f", 11 | "(membert {0 {5 {7} {1} {3}} {6} {8}} 7) -> #t", 12 | "(membert {0 {5 {7} {1} {3}} {6} {8}} 8) -> #t", 13 | "(membert {0 {5 {7} {1} {3}} {6} {8}} 0) -> #t", 14 | "(membert {12 {5 {7} {1} {3}} {6} {8}} 0) -> #f", 15 | "(membert {1 {3 {5 {7 {9}}}}} 9) -> #t", 16 | "(membert {1 {3 {5 {7 {9 {1} {2} {4} {6} {8}}}}}} 8) -> #t", 17 | "(membert {1 {3 {5 {7 {9 {1} {2} {4} {6} {8}}}}}} 12) -> #f" 18 | ], 19 | "background": [] 20 | } 21 | } -------------------------------------------------------------------------------- /bench/multfirst.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "multfirst", 3 | "description": "Replaces every item in a list with the first item.", 4 | "kind": "examples", 5 | "contents": { 6 | "examples": [ 7 | "(multfirst []) -> []", "(multfirst [1 0]) -> [1 1]", 8 | "(multfirst [0 1 0]) -> [0 0 0]", "(multfirst [2 0 2 3]) -> [2 2 2 2]" 9 | ], 10 | "background": [] 11 | } 12 | } -------------------------------------------------------------------------------- /bench/multlast.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "multlast", 3 | "description": "Replaces every item in a list with the last item.", 4 | "kind": "examples", 5 | "contents": { 6 | "examples": [ 7 | "(multlast []) -> []", "(multlast [1 0]) -> [0 0]", 8 | "(multlast [0 1 0]) -> [0 0 0]", "(multlast [2 0 2 3]) -> [3 3 3 3]" 9 | ], 10 | "background": [] 11 | } 12 | } -------------------------------------------------------------------------------- /bench/prependt.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "prependt", 3 | "description": "", 4 | "kind": "examples", 5 | "contents": { 6 | "examples": [ 7 | "(prependt {[]} 1) -> {[1]}", "(prependt {[]} 2) -> {[2]}", 8 | "(prependt {[1 2 3]} 1) -> {[1 1 2 3]}", 9 | "(prependt {[1 2 3] {[3 4]}} 1) -> {[1 1 2 3] {[1 3 4]}}", 10 | "(prependt {[1 2 3] {[3 4]} {[5 6]}} 7) -> {[7 1 2 3] {[7 3 4]} {[7 5 6]}}" 11 | ], 12 | "background": [] 13 | } 14 | } -------------------------------------------------------------------------------- /bench/replacet.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "replacet", 3 | "description": "", 4 | "kind": "examples", 5 | "contents": { 6 | "examples": [ 7 | "(replacet {[]} 1 2) -> {[]}", "(replacet {[1]} 1 2) -> {[2]}", 8 | "(replacet {[1 3 4]} 1 2) -> {[2 3 4]}", 9 | "(replacet {[1 3 4] {[4 5 6]}} 4 7) -> {[1 3 7] {[7 5 6]}}" 10 | ], 11 | "background": [] 12 | } 13 | } -------------------------------------------------------------------------------- /bench/searchnodes.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "searchnodes", 3 | "description": "", 4 | "kind": "examples", 5 | "contents": { 6 | "examples": [ 7 | "(searchnodes {} 1) -> #f", 8 | "(searchnodes {[3 2] {[4 1]}} 1) -> #t", 9 | "(searchnodes {[3 2] {[4 1]}} 2) -> #t", 10 | "(searchnodes {[3 2] {[4 1]}} 4) -> #t", 11 | "(searchnodes {[3 2] {[4 1]}} 0) -> #f", 12 | "(searchnodes {[3 2] {[4 1]}} 5) -> #f", 13 | "(searchnodes {[3 2] {[4 1]}} 6) -> #f", 14 | "(searchnodes {[3 2] {[4 1]}} 8) -> #f", 15 | "(searchnodes {[3 4] {[5]} {[6 4]}} 6) -> #t", 16 | "(searchnodes {[1 3] {[5]} {[2 3]}} 3) -> #t", 17 | "(searchnodes {[1 3] {[5]} {[2 3]}} 4) -> #f" 18 | ], 19 | "background": [ 20 | [ 21 | "member", "(lambda (b a) (foldl b (lambda (d c) (| d (= a c))) #f))" 22 | ] 23 | ] 24 | } 25 | } 26 | -------------------------------------------------------------------------------- /bench/selectnodes.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "selectnodes", 3 | "description": "", 4 | "kind": "examples", 5 | "contents": { 6 | "examples": [ 7 | "(selectnodes {}) -> []", "(selectnodes {1 {10} {25}}) -> [10]", 8 | "(selectnodes {1 {10} {20}}) -> [10 20]", 9 | "(selectnodes {30 {15} {25}}) -> [30]" 10 | ], 11 | "background": [ 12 | [ 13 | "join", 14 | "(lambda (a) (foldl a (lambda (c b) (foldr c (lambda (e d) (cons d e)) b)) []))" 15 | ], 16 | [ "pred", "(lambda (a) (= 0 (% a 2)))" ] 17 | ] 18 | } 19 | } -------------------------------------------------------------------------------- /bench/shiftl.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "shiftl", 3 | "description": 4 | "Shift all items in a list to the left. Requires the specification of $append$.", 5 | "kind": "examples", 6 | "contents": { 7 | "examples": [ 8 | "(shiftl []) -> []", "(shiftl [1]) -> [1]", "(shiftl [1 2]) -> [2 1]", 9 | "(shiftl [5 2 3]) -> [2 3 5]", "(shiftl [1 2 3 4]) -> [2 3 4 1]" 10 | ], 11 | "background": [ 12 | [ "reverse", "(lambda (a) (foldl a (lambda (c b) (cons b c)) []))" ] 13 | ] 14 | } 15 | } -------------------------------------------------------------------------------- /bench/shiftr.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "shiftr", 3 | "description": 4 | "Shift all items in a list to the right. Requires the specification of $last$.", 5 | "kind": "examples", 6 | "contents": { 7 | "examples": [ 8 | "(shiftr []) -> []", "(shiftr [1]) -> [1]", "(shiftr [1 2]) -> [2 1]", 9 | "(shiftr [0 2 3]) -> [3 0 2]", "(shiftr [1 2 3 4]) -> [4 1 2 3]", 10 | "(shiftr [2 9 7 4]) -> [4 2 9 7]" 11 | ], 12 | "background": [ 13 | [ "reverse", "(lambda (a) (foldl a (lambda (c b) (cons b c)) []))" ] 14 | ] 15 | } 16 | } -------------------------------------------------------------------------------- /bench/sum.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "sum", 3 | "description": "Returns the sum of a list.", 4 | "kind": "examples", 5 | "blacklist": ["sum"], 6 | "contents": { 7 | "examples": [ 8 | "(sum []) -> 0", "(sum [1]) -> 1", "(sum [1 3 5]) -> 9", 9 | "(sum [1 5]) -> 6" 10 | ], 11 | "background": [] 12 | } 13 | } 14 | -------------------------------------------------------------------------------- /bench/sumnodes.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "sumnodes", 3 | "description": "", 4 | "kind": "examples", 5 | "contents": { 6 | "examples": [ 7 | "(sumnodes {}) -> {}", "(sumnodes {[]}) -> {0}", 8 | "(sumnodes {[1]}) -> {1}", 9 | "(sumnodes {[1] {[1 2 3]} {[4 8]}}) -> {1 {6} {12}}" 10 | ], 11 | "background": [] 12 | } 13 | } -------------------------------------------------------------------------------- /bench/sums.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "sums", 3 | "description": "For list in a list of lists, sums the list.", 4 | "kind": "examples", 5 | "contents": { 6 | "examples": [ 7 | "(sums []) -> []", "(sums [[]]) -> [0]", "(sums [[1] []]) -> [1 0]", 8 | "(sums [[1 2] [3 4]]) -> [3 7]" 9 | ], 10 | "background": [] 11 | } 12 | } -------------------------------------------------------------------------------- /bench/sumt.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "sumt", 3 | "description": "Sums the nodes of a tree.", 4 | "kind": "examples", 5 | "contents": { 6 | "examples": [ 7 | "(sumt {}) -> 0", "(sumt {1}) -> 1", "(sumt {1 {2} {3}}) -> 6" 8 | ], 9 | "background": [] 10 | } 11 | } -------------------------------------------------------------------------------- /bench/sumtrees.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "sumtrees", 3 | "description": "", 4 | "kind": "examples", 5 | "contents": { 6 | "examples": [ 7 | "(sumtrees []) -> []", "(sumtrees [{} {1 {2} {3}}]) -> [0 6]", 8 | "(sumtrees [{5 {6}} {1}]) -> [11 1]" 9 | ], 10 | "background": [] 11 | } 12 | } -------------------------------------------------------------------------------- /bench/tconcat.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "tconcat", 3 | "description": "", 4 | "kind": "examples", 5 | "contents": { 6 | "examples": [ 7 | "(tconcat {1} {2 {3} {4}}) -> {1 {2 {3} {4}}}", 8 | "(tconcat {1 {2} {3}} {2 {3} {4}}) -> {1 {2 {2 {3} {4}}} {3 {2 {3} {4}}}}", 9 | "(tconcat {1 {2} {3 {4}}} {2 {3}}) -> {1 {2 {2 {3}}} {3 {4 {2 {3}}}}}" 10 | ], 11 | "background": [] 12 | } 13 | } -------------------------------------------------------------------------------- /bin/benchmark.py: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env python3 2 | 3 | ''' 4 | Usage: benchmark.py RUNFILE 5 | ''' 6 | 7 | from docopt import docopt 8 | from glob import glob 9 | import json 10 | import os 11 | import shlex 12 | from subprocess import Popen, PIPE 13 | from tqdm import tqdm 14 | 15 | def load_runfile(fn): 16 | with open(fn, 'r') as f: 17 | return json.load(f) 18 | 19 | def run_benchmark(runfile): 20 | max_mem = runfile['max_memory'] 21 | max_time = runfile['max_runtime'] 22 | l2_args = runfile['l2_args'] 23 | num_restarts = runfile['restarts'] 24 | timeout_path = runfile['timeout_path'] 25 | l2_path = runfile['l2_path'] 26 | 27 | runs = [] 28 | for bench in glob(runfile['bench']): 29 | for run in range(num_restarts): 30 | runs.append((bench, run)) 31 | 32 | for (bench, run) in tqdm(runs): 33 | bench_name = os.path.splitext(os.path.basename(bench))[0] 34 | for r in range(num_restarts): 35 | run_fn = '{}-run_{}.json'.format(bench_name, r) 36 | synth_fn = '{}-synth_{}.json'.format(bench_name, r) 37 | cmd = '{} -t {} -m {} -q --machine-readable -- {} synth {} -d {} {}'.\ 38 | format(timeout_path, max_mem, max_time, 39 | l2_path, l2_args, shlex.quote(synth_fn), shlex.quote(bench)) 40 | p = Popen(cmd, stdout=PIPE, shell=True) 41 | p.wait() 42 | stdout, _ = p.communicate() 43 | with open(run_fn, 'wb') as f: 44 | f.write(stdout) 45 | 46 | def main(args): 47 | print("Running benchmarks...") 48 | run_benchmark(load_runfile(args['RUNFILE'])) 49 | 50 | if __name__ == '__main__': 51 | args = docopt(__doc__) 52 | main(args) 53 | -------------------------------------------------------------------------------- /bin/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name l2_cli) 3 | (libraries l2 core core_extended yojson hashcons) 4 | (modules l2_cli) 5 | (preprocess (pps ppx_jane))) 6 | 7 | (install 8 | (section bin) 9 | (files (l2_cli.exe as l2))) 10 | -------------------------------------------------------------------------------- /bin/generate_functions.ml: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ocaml 2 | #use "topfind";; 3 | #thread;; 4 | #require "core.top";; 5 | #ppx "ppx-jane -as-ppx";; 6 | #require "l2";; 7 | 8 | open Core.Std 9 | open L2 10 | 11 | open Collections 12 | open Hypothesis 13 | open Infer 14 | open Synthesis_common 15 | open V2_engine 16 | 17 | module Sp = Specification 18 | 19 | let rec generate_value : ?max_int:int -> ?max_len:int -> Type.t -> Value.t = 20 | let open Type in 21 | fun ?(max_int = 10) ?(max_len = 5) -> function 22 | | Const_t Num_t -> `Num (Random.int (max_int + 1)) 23 | | App_t ("list", [t]) -> 24 | let len = Random.int (max_int + 1) in 25 | `List (List.init len ~f:(fun _ -> generate_value ~max_int ~max_len t)) 26 | | t -> failwiths "Unsupported type." t [%sexp_of:Type.t] 27 | 28 | let generate_inputs : Type.t -> Value.t list = 29 | let open Type in 30 | function 31 | | Arrow_t (input_ts, _) -> List.map input_ts ~f:generate_value 32 | | t -> failwiths "Not an arrow type." t [%sexp_of:Type.t] 33 | 34 | let generate_expr : cost:int -> Library.t -> Type.t -> Expr.t list = 35 | let module H = Hypothesis in 36 | fun ~cost library type_ -> 37 | let cost_model = V2_engine.default_cost_model in 38 | 39 | let initial_hypo = 40 | H.hole 41 | cost_model 42 | (Hole.create type_ L2_Generalizer.Symbols.lambda) 43 | Specification.top 44 | in 45 | let gen = V2_engine.L2_Generalizer.With_components.create cost_model library in 46 | 47 | let rec loop hypo = 48 | let hypos = Generalizer.generalize_single { cost_model; library } gen hypo in 49 | print_endline "Generalizing:"; 50 | print_endline (H.to_string hypo); 51 | 52 | let small_abstract = List.filter hypos ~f:(fun h -> 53 | H.cost h + (H.holes h |> List.length) <= cost && H.kind h = H.Abstract) 54 | in 55 | let concrete = List.filter hypos ~f:(fun h -> 56 | H.cost h >= cost && H.kind h = H.Concrete) 57 | in 58 | if List.length concrete > 0 then 59 | concrete |> List.map ~f:H.to_expr 60 | else 61 | List.concat_map small_abstract ~f:loop 62 | (* let choices = *) 63 | (* (if List.length small_abstract > 0 then [`Abstract] else []) @ *) 64 | (* (if List.length concrete > 0 then [`Concrete] else []) *) 65 | (* in *) 66 | (* printf "%d\n" (List.length choices); *) 67 | (* flush stdout; *) 68 | (* match List.random choices with *) 69 | (* | Some `Abstract -> *) 70 | (* List.permute small_abstract *) 71 | (* |> List.find_map ~f:loop *) 72 | (* | Some `Concrete -> Some (Option.value_exn (List.random concrete) |> H.to_expr) *) 73 | (* | None -> None *) 74 | in 75 | 76 | loop initial_hypo 77 | 78 | let generate_exprs : cost:int -> Library.t -> Type.t -> Expr.t Sequence.t = 79 | let module H = Hypothesis in 80 | let module Seq = Sequence in 81 | fun ~cost library type_ -> 82 | let cost_model = V2_engine.default_cost_model in 83 | 84 | let initial_hypo = 85 | H.hole 86 | cost_model 87 | (Hole.create type_ L2_Generalizer.Symbols.lambda) 88 | Specification.top 89 | in 90 | let gen = V2_engine.L2_Generalizer.With_components.create cost_model library in 91 | 92 | let rec loop hypo = 93 | printf "Generalizing: %s\n" (H.to_string_hum hypo); 94 | let hypos = 95 | Generalizer.(generalize_single { cost_model; library } gen hypo) 96 | in 97 | 98 | let small_abstract = 99 | List.filter hypos ~f:(fun h -> 100 | H.cost h + (H.holes h |> List.length) <= cost && H.kind h = H.Abstract) 101 | |> List.permute 102 | in 103 | let concrete = 104 | List.filter hypos ~f:(fun h -> H.cost h = cost && H.kind h = H.Concrete) 105 | in 106 | if List.length concrete > 0 then 107 | Seq.of_list concrete 108 | else 109 | Seq.concat_map (Seq.of_list small_abstract) ~f:loop 110 | 111 | (* let choices = *) 112 | (* (if List.length small_abstract > 0 then [`Abstract] else []) @ *) 113 | (* (if List.length concrete > 0 then [`Concrete] else []) *) 114 | (* in *) 115 | (* printf "%d\n" (List.length choices); *) 116 | (* flush stdout; *) 117 | (* match List.random choices with *) 118 | (* | Some `Abstract -> *) 119 | (* List.permute small_abstract *) 120 | (* |> List.find_map ~f:loop *) 121 | (* | Some `Concrete -> Some (Option.value_exn (List.random concrete) |> H.to_expr) *) 122 | (* | None -> None *) 123 | in 124 | 125 | loop initial_hypo |> Seq.map ~f:H.to_expr 126 | 127 | let generate_spec 128 | : (Value.t list) list -> Library.t -> Type.t -> Expr.t -> Sp.t = 129 | fun inputs l t e -> 130 | try 131 | List.map inputs ~f:(fun ins -> 132 | let ins = List.map ins ~f:Expr.of_value in 133 | let out = 134 | Eval.eval ~recursion_limit:100 (ref l.Library.value_ctx) (`Apply (e, ins)) 135 | in 136 | (ins, out)) 137 | |> FunctionExamples.of_input_output_list_exn 138 | |> FunctionExamples.to_spec 139 | with 140 | | Eval.HitRecursionLimit -> Sp.bottom 141 | | Eval.RuntimeError err -> Sp.bottom 142 | 143 | let is_interesting : Sp.t -> bool = 144 | fun spec -> 145 | match Sp.data spec with 146 | | Sp.Bottom -> false 147 | | FunctionExamples.FunctionExamples exs -> 148 | let outs = 149 | FunctionExamples.to_list exs 150 | |> List.map ~f:Tuple.T2.get2 151 | in 152 | not (List.all_equal outs) 153 | | _ -> true 154 | 155 | type out = { 156 | function_ : Expr.t; 157 | spec : Sp.t; 158 | } [@@deriving sexp] 159 | 160 | let cmd = 161 | let spec = 162 | let open Command.Spec in 163 | empty 164 | +> flag "-v" ~aliases:["--verbose"] no_arg ~doc:" print verbose output" 165 | +> anon ("max-cost" %: int) 166 | +> anon ("library" %: file) 167 | +> anon ("type" %: string) 168 | +> anon ("out-dir" %: string) 169 | in 170 | 171 | let run verbose max_cost library_fn type_str out_dir () = 172 | let library = Library.from_file_exn library_fn in 173 | let type_ = Type.of_string_exn type_str in 174 | 175 | Status.disable (); 176 | 177 | let type_str = Type.to_string type_ in 178 | 179 | let num_examples = 10 in 180 | let inputs = List.init num_examples ~f:(fun _ -> generate_inputs type_) in 181 | let discarded = ref 0 in 182 | let duplicates = ref 0 in 183 | 184 | (* Memoizer.to_flat_sequence memoizer ~min_cost:0 ~max_cost initial_hypo *) 185 | 186 | (* Sequence.repeat () *) 187 | 188 | (* |> Sequence.map ~f:(fun _ -> *) 189 | (* generate_expr ~cost:max_cost library type_ *) 190 | (* ) *) 191 | (* |> Sequence.concat_map ~f:Sequence.of_list *) 192 | 193 | generate_exprs ~cost:max_cost library type_ 194 | 195 | |> Sequence.map ~f:(fun e -> 196 | { 197 | function_ = e; 198 | spec = generate_spec inputs library type_ e; 199 | } 200 | ) 201 | 202 | |> Sequence.mapi ~f:(fun i out -> 203 | if i % 100 = 0 then begin 204 | printf "%d discarded\n" !discarded; 205 | printf "%d duplicates\n" !duplicates; 206 | end; 207 | out) 208 | 209 | |> Sequence.filter ~f:(fun x -> 210 | if is_interesting x.spec then true else begin 211 | incr discarded; 212 | false 213 | end) 214 | 215 | |> Sequence.unfold_with ~init:Sp.Set.empty ~f:(fun specs x -> 216 | let open Sequence.Step in 217 | if Set.mem specs x.spec then begin 218 | incr duplicates; 219 | Skip specs 220 | end 221 | else 222 | Yield (x, Set.add specs x.spec) 223 | ) 224 | 225 | |> Sequence.inspect ~f:(fun out -> 226 | print_endline (Expr.to_string out.function_); 227 | print_endline (Specification.to_string out.spec); 228 | print_newline ()) 229 | 230 | |> Sequence.iteri ~f:(fun i out -> 231 | let fn = sprintf "%s/%s_%d.sexp" out_dir type_str i in 232 | Out_channel.with_file fn ~f:(fun ch -> 233 | [%sexp_of:out] out 234 | |> Sexp.to_string_hum 235 | |> Out_channel.output_string ch); 236 | 237 | let name = sprintf "f%d" i in 238 | let exs = match Sp.data out.spec with 239 | | FunctionExamples.FunctionExamples exs -> 240 | FunctionExamples.to_list exs 241 | |> List.map ~f:(fun ((_, ins), out) -> 242 | `Apply (`Id name, List.map ins ~f:Expr.of_value), Expr.of_value out) 243 | in 244 | let testcase = Testcase.({ 245 | name; desc = ""; case = Examples (exs, []); blacklist = []; 246 | }) 247 | in 248 | let fn = sprintf "%s/%s_%d.json" out_dir type_str i in 249 | Testcase.to_file_exn ~filename:fn testcase 250 | ); 251 | in 252 | 253 | Command.basic ~summary:"Generate functions." spec run 254 | 255 | let () = 256 | Command.run cmd 257 | 258 | -------------------------------------------------------------------------------- /bin/generate_values.ml: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ocaml 2 | #use "topfind";; 3 | #thread;; 4 | #require "core.top";; 5 | #ppx "ppx-jane -as-ppx";; 6 | #require "l2";; 7 | 8 | open Core.Std 9 | open L2 10 | 11 | open Collections 12 | open Hypothesis 13 | open Infer 14 | open Synthesis_common 15 | open Util 16 | open Fast_example_deduction 17 | 18 | module Seq = Sequence 19 | 20 | module Sk = Skeleton 21 | module Sp = Specification 22 | module H = Hypothesis 23 | 24 | type config = { 25 | verbose : bool; 26 | library : Library.t; 27 | domain : Fast_example_deduction.domain; 28 | } 29 | 30 | let rec normalize ctx count = function 31 | | `AbsInt _ 32 | | `Bool _ 33 | | `Bottom 34 | | `Top as x -> x 35 | | `AbsEq (Abstract_eq.Elem x) -> 36 | begin match Map.find !ctx x with 37 | | Some x' -> `AbsEq (Abstract_eq.Elem x') 38 | | None -> 39 | let x' = !count in 40 | incr count; 41 | ctx := Map.add !ctx ~key:x ~data:x'; 42 | `AbsEq (Abstract_eq.Elem x') 43 | end 44 | | `AbsEq Abstract_eq.Omega -> `AbsEq Abstract_eq.Omega 45 | | `AbsList x -> `AbsList (Abstract_list.map ~f:(normalize ctx count) x) 46 | | `List x -> `List (List.map ~f:(normalize ctx count) x) 47 | | `Tree x -> `Tree (Tree.map ~f:(normalize ctx count) x) 48 | | x -> failwiths "Unsupported value." x [%sexp_of:Abstract_value.t] 49 | 50 | let generate_abs_values : config -> ImmutableType.t -> Abstract_value.t Seq.t = 51 | let module IT = ImmutableType in 52 | fun config type_ -> 53 | let rec gen = function 54 | | IT.Const_i Num_t -> 55 | Abstract_int.enumerate config.domain.int 56 | |> Seq.map ~f:(fun v -> `AbsInt v) 57 | | IT.Const_i Bool_t -> Seq.of_list [`Bool true; `Bool false] 58 | | IT.Quant_i _ -> Abstract_eq.enumerate config.domain.eq |> Seq.map ~f:(fun v -> `AbsEq v) 59 | | IT.App_i ("list", [elem_type]) -> 60 | let elems = gen elem_type |> Seq.to_list in 61 | Abstract_list.enumerate config.domain.list elems 62 | |> Seq.map ~f:(fun v -> `AbsList v) 63 | | t -> failwiths "Unsupported type." t [%sexp_of:IT.t] 64 | in 65 | gen type_ 66 | 67 | let generate_examples : config -> Expr.t -> Type.t -> Abstract_example.t Sequence.t = 68 | let module IT = ImmutableType in 69 | fun config func type_ -> 70 | match IT.of_type type_ with 71 | | ImmutableType.Arrow_i (args_t, ret_t) -> 72 | let inputs = 73 | List.map args_t ~f:(generate_abs_values config) 74 | |> List.map ~f:Seq.memoize 75 | |> Seq.product 76 | |> Seq.map ~f:(fun vs -> 77 | let ctx = ref Int.Map.empty in 78 | let count = ref 0 in 79 | List.map ~f:(fun v -> normalize ctx count v) vs) 80 | |> Seq.to_list 81 | |> List.dedup 82 | |> Seq.of_list 83 | in 84 | let ctx = 85 | List.fold_left config.library.Library.exprs 86 | ~init:String.Map.empty ~f:(fun ctx (name, expr) -> 87 | let ctx_ref = ref ctx in 88 | let abs_expr = Abstract_expr.of_expr expr in 89 | let value = 90 | Abstract_value.eval 91 | ~recursion_limit:(`Limited 1000) 92 | ~ctx:ctx_ref 93 | ~int_domain:config.domain.int 94 | ~list_domain:config.domain.list 95 | (`Let (name, abs_expr, `Id name)) 96 | in 97 | Map.add !ctx_ref ~key:name ~data:value) 98 | in 99 | 100 | let abs_func = Abstract_expr.of_expr func in 101 | Seq.map inputs ~f:(fun args -> 102 | let abs_args = List.map ~f:Abstract_value.to_expr args in 103 | let ret = 104 | Abstract_value.eval 105 | ~ctx:(ref ctx) 106 | ~recursion_limit:(`Limited 1000) 107 | ~int_domain:config.domain.int 108 | ~list_domain:config.domain.list 109 | (`Apply (abs_func, abs_args)) 110 | in 111 | args, ret) 112 | |> Seq.concat_map ~f:(fun (ins, out) -> 113 | match out with 114 | | `Top -> 115 | generate_abs_values config ret_t 116 | |> Seq.map ~f:(fun out' -> (ins, out')) 117 | | _ -> Seq.singleton (ins, out)) 118 | 119 | | t -> failwiths "Unexpected type." t [%sexp_of:IT.t] 120 | 121 | let save_examples : file:string -> config:config -> Abstract_example.t Sequence.t -> unit = 122 | fun ~file ~config exs -> 123 | let exs = Seq.to_list exs in 124 | let fs = Function_spec.of_examples config.domain exs in 125 | print_endline (Function_spec.to_string fs); 126 | Function_spec.to_file fs file 127 | 128 | let view_sequence : 'a Sequence.t -> f:('a -> string) -> 'a Sequence.t = fun s ~f -> 129 | Sequence.map s ~f:(fun x -> printf "%s\n" (f x); flush stdout; x) 130 | 131 | let generate_for_func : config:config -> file:string -> Expr.t -> Type.t -> unit = 132 | fun ~config ~file func type_ -> 133 | let exs = generate_examples config func type_ in 134 | let exs = if config.verbose then 135 | view_sequence exs ~f:(fun (ins, out) -> 136 | sprintf "(%s) -> %s" 137 | (List.map ins ~f:Abstract_value.to_string |> String.concat ~sep:", ") 138 | (Abstract_value.to_string out)) 139 | else exs 140 | in 141 | save_examples ~file ~config exs 142 | 143 | let spec = 144 | let open Command.Spec in 145 | empty 146 | +> flag "-v" ~aliases:["--verbose"] no_arg ~doc:" print verbose output" 147 | +> anon ("library" %: file) 148 | +> anon (sequence ("function" %: string)) 149 | 150 | let run verbose library_fn names () = 151 | let err = 152 | let module Let_syntax = Or_error.Let_syntax.Let_syntax in 153 | let%bind library = Library.from_file library_fn in 154 | 155 | let config = { 156 | verbose; library; 157 | domain = { 158 | int = { lower = 0; upper = 10 }; 159 | eq = { max_distinct = 4 }; 160 | list = { max_length = 4 }; 161 | } 162 | } in 163 | 164 | let functions = 165 | library.Library.type_ctx |> Map.to_alist |> List.map ~f:(fun (name, type_) -> 166 | let args_names = List.init (Type.arity type_) ~f:(fun i -> Int.to_string i) in 167 | let args_ids = List.map args_names ~f:(fun n -> `Id n) in 168 | (name, type_, `Lambda (args_names, `Apply (`Id name, args_ids)))) 169 | in 170 | 171 | let operators = Expr.Op.all |> List.map ~f:(fun op -> 172 | let name = Expr.Op.to_string op in 173 | let type_ = Expr.Op.typ op in 174 | let args_names = List.init (Expr.Op.arity op) ~f:(fun i -> Int.to_string i) in 175 | let args_ids = List.map args_names ~f:(fun n -> `Id n) in 176 | (name, type_, `Lambda (args_names, `Op (op, args_ids)))) 177 | in 178 | 179 | let selected = 180 | List.filter (functions @ operators) ~f:(fun (n, _, _) -> List.mem names n) 181 | in 182 | 183 | List.iter selected ~f:(fun (name, type_, expr) -> 184 | let file = name ^ "-examples.sexp" in 185 | generate_for_func ~config ~file expr type_); 186 | 187 | Ok () 188 | in 189 | 190 | match err with 191 | | Ok () -> () 192 | | Error err -> print_string (Error.to_string_hum err) 193 | 194 | let cmd = Command.basic ~summary:"Generate specifications for functions." spec run 195 | 196 | let () = Command.run cmd 197 | -------------------------------------------------------------------------------- /components/list.ml: -------------------------------------------------------------------------------- 1 | builtins: ::, car, cdr, + 2 | -------------------------------------------------------------------------------- /components/stdlib.ml: -------------------------------------------------------------------------------- 1 | builtin +, -, /, *, %, =, <>, <, <=, >, >=, &&, ||, not, if, ::, car, cdr, tree, value, children 2 | 3 | let inf = 4611686018427387903 4 | 5 | let rec foldr = fun l f i -> 6 | if l = [] then i else 7 | f (foldr (cdr l) f i) (car l) 8 | 9 | let rec foldl = fun l f i -> 10 | if l = [] then i else 11 | foldl (cdr l) f (f i (car l)) 12 | 13 | let rec map = fun l f -> 14 | if l = [] then [] else 15 | (f (car l)) :: map (cdr l) f 16 | 17 | let rec filter = fun l f -> 18 | if l = [] then [] else 19 | let rest = filter (cdr l) f in 20 | if f (car l) then (car l) :: rest else rest 21 | 22 | let filteri l f = 23 | let rec filteri_k l f k = 24 | if l = [] then [] else 25 | let rest = filteri_k (cdr l) f (k + 1) in 26 | if f k (car l) then (car l) :: rest else rest 27 | in 28 | filteri_k l f 0 29 | 30 | let mapi l f = 31 | let rec mapi_k l f k = 32 | if l = [] then [] else 33 | f k (car l) :: mapi_k (cdr l) f (k + 1) 34 | in 35 | mapi_k l f 0 36 | 37 | let rec mapt = fun t f -> 38 | if t = {} then {} else 39 | tree (f (value t)) (map (children t) (fun c -> mapt c f)) 40 | 41 | let rec foldt = fun t f i -> 42 | if t = {} then i else 43 | f (map (children t) (fun ct -> foldt ct f i)) (value t) 44 | 45 | let rec merge = fun x y -> 46 | if x = [] then y else if y = [] then x else 47 | let a = car x in 48 | let b = car y in 49 | if a < b then a :: (merge (cdr x) y) else b :: (merge x (cdr y)) 50 | 51 | let rec take = fun l x -> 52 | if l = [] then [] else 53 | if x > 0 then (car l) :: (take (cdr l) (x - 1)) else [] 54 | 55 | let rec zip = fun x y -> 56 | if x = [] && y = [] then [] else 57 | [(car x); (car y)] :: (zip (cdr x) (cdr y)) 58 | 59 | let rec intersperse = fun l e -> 60 | if l = [] then [] else 61 | let xs = cdr l in 62 | if xs = [] then l else (car l) :: (e :: (intersperse xs e)) 63 | 64 | let rec append = fun l1 l2 -> 65 | if l1 = [] then l2 else 66 | if l2 = [] then l1 else 67 | (car l1) :: (append (cdr l1) l2) 68 | 69 | let rec reverse = fun l -> 70 | if l = [] then [] else append (reverse (cdr l)) (car l :: []) 71 | 72 | let rec concat = fun l -> 73 | if l = [] then [] else 74 | append (car l) (concat (cdr l)) 75 | 76 | let rec drop = fun l x -> 77 | if x = 0 || l = [] then l else 78 | drop (cdr l) (x - 1) 79 | 80 | let rec sort = fun l -> 81 | if l = [] then [] else 82 | let p = car l in 83 | let lesser = filter (cdr l) (fun e -> e < p) in 84 | let greater = filter (cdr l) (fun e -> e >= p) in 85 | append (sort lesser) (p :: (sort greater)) 86 | 87 | let rec dedup = fun l -> 88 | if l = [] then [] else 89 | if (cdr l) = [] then l else 90 | let sl = sort l in 91 | let x1 = car sl in 92 | let x2 = car (cdr sl) in 93 | if x1 = x2 then dedup (cdr sl) else x1 :: (dedup (cdr sl)) 94 | 95 | let rec len l = 96 | if l = [] then 0 else 1 + (len (cdr l)) 97 | 98 | let nth l n = car (drop l n) 99 | 100 | let rec exists l x = 101 | if l = [] then false else 102 | if x = (car l) then true else 103 | exists (cdr l) x 104 | 105 | let split_n l n = [take l n; drop l n] 106 | 107 | let rec unzip l = 108 | if l = [] then [[]; []] else 109 | let hd = car l in 110 | let hd1 = car hd in 111 | let hd2 = car (cdr hd) in 112 | let tl = unzip (cdr l) in 113 | let tl1 = car tl in 114 | let tl2 = car (cdr tl) in 115 | [hd1::tl1; hd2::tl2] 116 | 117 | let last l = car (reverse l) 118 | 119 | let rec count l x = 120 | if l = [] then 0 else 121 | if car l = x then 122 | 1 + (count (cdr l) x) 123 | else 124 | count (cdr l) x 125 | 126 | let range n = 127 | let rec range_k k = 128 | if k >= n then [] else 129 | k :: (range_k (k + 1)) 130 | in 131 | range_k 0 132 | 133 | let sub l pos len = take (drop l pos) len 134 | 135 | let is_empty l = l = [] 136 | 137 | let rec list_and l = 138 | if l = [] then true else 139 | (car l) && (list_and (cdr l)) 140 | 141 | let rec list_or l = 142 | if l = [] then false else 143 | (car l) || (list_or (cdr l)) 144 | 145 | let rec repeat x n = 146 | if n = 0 then [] else 147 | x :: (repeat x (n - 1)) 148 | 149 | let rec delete_first l x = 150 | if l = [] then [] else 151 | if (car l) = x then cdr l else 152 | (car l) :: (delete_first (cdr l) x) 153 | 154 | let rec delete_all l x = 155 | if l = [] then [] else 156 | if (car l) = x then delete_all (cdr l) x else 157 | (car l) :: (delete_all (cdr l) x) 158 | 159 | let rec union l1 l2 = dedup (append l1 l2) 160 | 161 | let rec intersect l1 l2 = 162 | if l1 = [] then [] else if l2 = [] then [] else 163 | let x = car l1 in 164 | if exists l2 x then 165 | x :: (intersect (delete_all l1 x) l2) 166 | else 167 | intersect (delete_all l1 x) l2 168 | 169 | let rec replace l x y = 170 | if l = [] then [] else 171 | if (car l) = x then 172 | y :: (replace (cdr l) x y) 173 | else 174 | (car l) :: (replace (cdr l) x y) 175 | 176 | (** Int list functions *) 177 | let rec sum x = 178 | if x = [] then 0 else (car x) + (sum (cdr x)) 179 | 180 | let mean x = (sum x) / (len x) 181 | 182 | let median x = 183 | car (drop (sort x) ((len x) / 2)) 184 | 185 | let min x = car (sort x) 186 | 187 | let max x = car (reverse (sort x)) 188 | 189 | let rec product x = 190 | if x = [] then 1 else 191 | (car x) * (product (cdr x)) 192 | 193 | (** Integer functions. *) 194 | let rec pow = fun x y -> 195 | if y = 0 then 1 else x * (pow x (y - 1)) 196 | 197 | let neg = fun x -> -1 * x 198 | 199 | let fact x = 200 | if x = 0 then 1 else x * (fact (x - 1)) 201 | 202 | let abs x = 203 | if x < 0 then (-1) * x else x 204 | 205 | let even x = x % 2 = 0 206 | let odd x = not (even x) 207 | -------------------------------------------------------------------------------- /default_cost.json: -------------------------------------------------------------------------------- 1 | { 2 | "num" : 1, 3 | "bool": 1, 4 | "hole": 0, 5 | "lambda": 1, 6 | "_let": 1, 7 | "list": 1, 8 | "tree": 1, 9 | "var ": 1, 10 | "call": { 11 | "foldr": 3, 12 | "foldl": 3, 13 | "foldt": 3, 14 | "map": 2, 15 | "mapt": 2, 16 | "filter": 2 17 | }, 18 | "call_default": 1 19 | } 20 | -------------------------------------------------------------------------------- /dune: -------------------------------------------------------------------------------- 1 | (env 2 | (dev 3 | (flags (:standard -w -3-27-33)))) 4 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 1.6) 2 | (using menhir 2.0) 3 | -------------------------------------------------------------------------------- /l2.opam: -------------------------------------------------------------------------------- 1 | opam-version: "1.2" 2 | name: "l2" 3 | version: "2.0" 4 | maintainer: "Jack Feser " 5 | authors: "Jack Feser " 6 | homepage: "https://github.com/jfeser/L2" 7 | bug-reports: "https://github.com/jfeser/L2/issues" 8 | doc: "https://jfeser.github.io/L2/" 9 | license: "Apache2.0" 10 | dev-repo: "https://github.com/jfeser/L2.git" 11 | build: [["dune" "build" "-p" name "-j" jobs]] 12 | depends: [ 13 | "dune" {build & >= "1.1"} 14 | "menhir" {build} 15 | "ounit" {>= "2" & < "2.1"} 16 | "core" {>= "v0.11.3" & < "v0.12"} 17 | "core_extended" {>= "v0.11.0" & < "v0.12"} 18 | "ppx_jane" {>= "v0.11.0" & < "v0.12"} 19 | "yojson" {>= "1.5" & < "2"} 20 | "hashcons" {>= "1.3" & < "2"} 21 | ] 22 | -------------------------------------------------------------------------------- /l2.opam.locked: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | name: "l2" 3 | version: "2.0" 4 | maintainer: "Jack Feser " 5 | authors: "Jack Feser " 6 | homepage: "https://github.com/jfeser/L2" 7 | bug-reports: "https://github.com/jfeser/L2/issues" 8 | doc: "https://jfeser.github.io/L2/" 9 | license: "Apache2.0" 10 | dev-repo: "git+https://github.com/jfeser/L2.git" 11 | build: [["dune" "build" "-p" name "-j" jobs]] 12 | depends: [ 13 | "base" {= "v0.11.1"} 14 | "base-bigarray" {= "base"} 15 | "base-bytes" {= "base"} 16 | "base-threads" {= "base"} 17 | "base-unix" {= "base"} 18 | "bin_prot" {= "v0.11.0"} 19 | "biniou" {= "1.2.1"} 20 | "conf-autoconf" {= "0.1"} 21 | "conf-m4" {= "1"} 22 | "conf-which" {= "1"} 23 | "configurator" {= "v0.11.0"} 24 | "core" {= "v0.11.3"} 25 | "core_extended" {= "v0.11.0"} 26 | "core_kernel" {= "v0.11.1"} 27 | "cppo" {= "1.6.6"} 28 | "dune" {= "2.7.0"} 29 | "easy-format" {= "1.3.2"} 30 | "fieldslib" {= "v0.11.0"} 31 | "hashcons" {= "1.3"} 32 | "jane-street-headers" {= "v0.11.0"} 33 | "jbuilder" {= "1.0+beta20.2"} 34 | "menhir" {= "20200624"} 35 | "menhirLib" {= "20200624"} 36 | "menhirSdk" {= "20200624"} 37 | "num" {= "1.3"} 38 | "ocaml" {= "4.07.1"} 39 | "ocaml-base-compiler" {= "4.07.1"} 40 | "ocaml-compiler-libs" {= "v0.12.1"} 41 | "ocaml-config" {= "1"} 42 | "ocaml-migrate-parsetree" {= "1.7.3"} 43 | "ocaml-secondary-compiler" {= "4.08.1-1"} 44 | "ocamlbuild" {= "0.14.0"} 45 | "ocamlfind" {= "1.8.1"} 46 | "ocamlfind-secondary" {= "1.8.1"} 47 | "octavius" {= "1.2.2"} 48 | "ounit" {= "2.0.8"} 49 | "parsexp" {= "v0.11.0"} 50 | "ppx_assert" {= "v0.11.0"} 51 | "ppx_base" {= "v0.11.0"} 52 | "ppx_bench" {= "v0.11.0"} 53 | "ppx_bin_prot" {= "v0.11.1"} 54 | "ppx_compare" {= "v0.11.1"} 55 | "ppx_custom_printf" {= "v0.11.0"} 56 | "ppx_derivers" {= "1.2.1"} 57 | "ppx_enumerate" {= "v0.11.1"} 58 | "ppx_expect" {= "v0.11.1"} 59 | "ppx_fail" {= "v0.11.0"} 60 | "ppx_fields_conv" {= "v0.11.0"} 61 | "ppx_hash" {= "v0.11.1"} 62 | "ppx_here" {= "v0.11.0"} 63 | "ppx_inline_test" {= "v0.11.0"} 64 | "ppx_jane" {= "v0.11.0"} 65 | "ppx_js_style" {= "v0.11.0"} 66 | "ppx_let" {= "v0.11.0"} 67 | "ppx_optcomp" {= "v0.11.0"} 68 | "ppx_optional" {= "v0.11.0"} 69 | "ppx_pipebang" {= "v0.11.0"} 70 | "ppx_sexp_conv" {= "v0.11.2"} 71 | "ppx_sexp_message" {= "v0.11.0"} 72 | "ppx_sexp_value" {= "v0.11.0"} 73 | "ppx_typerep_conv" {= "v0.11.1"} 74 | "ppx_variants_conv" {= "v0.11.1"} 75 | "ppxlib" {= "0.8.1"} 76 | "re" {= "1.9.0"} 77 | "re2" {= "v0.11.0"} 78 | "result" {= "1.5"} 79 | "seq" {= "base"} 80 | "sexplib" {= "v0.11.0"} 81 | "sexplib0" {= "v0.11.0"} 82 | "spawn" {= "v0.13.0"} 83 | "splittable_random" {= "v0.11.0"} 84 | "stdio" {= "v0.11.0"} 85 | "textutils" {= "v0.11.0"} 86 | "textutils_kernel" {= "v0.11.0"} 87 | "typerep" {= "v0.11.0"} 88 | "variantslib" {= "v0.11.0"} 89 | "yojson" {= "1.7.0"} 90 | ] 91 | -------------------------------------------------------------------------------- /lib/ast.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | open Collections 3 | 4 | exception ParseError of string 5 | 6 | type id = string [@@deriving compare, sexp, bin_io] 7 | 8 | (** Represents the type of a value or expression. *) 9 | type typ = 10 | | Const_t of const_typ 11 | | App_t of id * typ list 12 | | Arrow_t of typ list * typ 13 | | Var_t of var_typ ref 14 | 15 | and const_typ = Num_t | Bool_t 16 | 17 | (** Type variables can be either free or quantified. A type scheme 18 | cannot contain free type variables. *) 19 | and var_typ = Free of int * level | Link of typ | Quant of string 20 | 21 | and level = int [@@deriving compare, sexp] 22 | 23 | type op = 24 | | Plus 25 | | Minus 26 | | Mul 27 | | Div 28 | | Mod 29 | | Eq 30 | | Neq 31 | | Lt 32 | | Leq 33 | | Gt 34 | | Geq 35 | | And 36 | | Or 37 | | Not 38 | | If 39 | | RCons 40 | | Cons 41 | | Car 42 | | Cdr 43 | | Tree 44 | | Value 45 | | Children 46 | [@@deriving compare, sexp] 47 | 48 | type expr = 49 | [ `Num of int 50 | | `Bool of bool 51 | | `List of expr list 52 | | `Tree of expr Tree.t 53 | | `Id of id 54 | | `Let of id * expr * expr 55 | | `Lambda of id list * expr 56 | | `Apply of expr * expr list 57 | | `Op of op * expr list ] 58 | [@@deriving compare, sexp] 59 | 60 | type example = expr * expr [@@deriving compare, sexp] 61 | 62 | type constr = expr * id list [@@deriving compare, sexp] 63 | 64 | type value = 65 | [ `Num of int 66 | | `Bool of bool 67 | | `List of value list 68 | | `Tree of value Tree.t 69 | | `Closure of expr * value Ctx.t 70 | | `Unit ] 71 | [@@deriving compare, sexp] 72 | -------------------------------------------------------------------------------- /lib/combinat.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | module Seq = Sequence 3 | 4 | let m_partition : int -> int -> Array.Int.t Seq.t = 5 | fun n m -> 6 | (* if m <= 0 then failwiths "'m' must be greater than or equal to 1." m [%sexp_of:int]; *) 7 | if n < m then Seq.empty 8 | else if m <= 0 then Seq.empty 9 | else if m = 1 then Seq.singleton (Array.create ~len:1 n) 10 | else 11 | let a_init = Array.create ~len:m 1 in 12 | a_init.(0) <- n - m + 1 ; 13 | let init_seq = Seq.singleton a_init in 14 | let rest_seq = 15 | Seq.unfold ~init:a_init ~f:(fun a -> 16 | let a = Array.copy a in 17 | if a.(1) >= a.(0) - 1 then ( 18 | let j = ref 2 in 19 | let s = ref (a.(0) + a.(1) - 1) in 20 | while !j < m && a.(!j) >= a.(0) - 1 do 21 | s := !s + a.(!j) ; 22 | incr j 23 | done ; 24 | if !j >= m then None 25 | else 26 | let x = a.(!j) + 1 in 27 | a.(!j) <- x ; 28 | decr j ; 29 | while !j > 0 do 30 | a.(!j) <- x ; 31 | s := !s - x ; 32 | decr j 33 | done ; 34 | a.(0) <- !s ; 35 | Some (Array.copy a, a) ) 36 | else ( 37 | a.(0) <- a.(0) - 1 ; 38 | a.(1) <- a.(1) + 1 ; 39 | Some (Array.copy a, a) ) ) 40 | in 41 | Seq.append init_seq rest_seq 42 | 43 | let m_partition_with_zeros : int -> int -> Array.Int.t Seq.t = 44 | fun n m -> 45 | if n = 0 then Array.create ~len:m 0 |> Seq.singleton 46 | else 47 | Seq.init (m + 1) ~f:(fun m' -> 48 | m_partition n m' 49 | |> Seq.map ~f:(fun p -> 50 | let p' = Array.create ~len:m 0 in 51 | Array.blito ~src:p ~dst:p' () ; 52 | p' ) ) 53 | |> Seq.concat 54 | 55 | let permutations : Array.Int.t -> Array.Int.t Seq.t = 56 | fun a_init -> 57 | let a_init = Array.copy a_init in 58 | Array.sort ~compare:Int.compare a_init ; 59 | let init_seq = Seq.singleton a_init in 60 | let rest_seq = 61 | Seq.unfold ~init:a_init ~f:(fun a -> 62 | let a = Array.copy a in 63 | let n = Array.length a in 64 | let j = ref (n - 2) in 65 | while !j >= 0 && a.(!j) >= a.(!j + 1) do 66 | decr j 67 | done ; 68 | if !j < 0 then None 69 | else 70 | let l = ref (n - 1) in 71 | while a.(!j) >= a.(!l) do 72 | decr l 73 | done ; 74 | Array.swap a !j !l ; 75 | let k = ref (!j + 1) in 76 | let l = ref (n - 1) in 77 | while !k < !l do 78 | Array.swap a !k !l ; incr k ; decr l 79 | done ; 80 | Some (a, a) ) 81 | in 82 | Seq.append init_seq rest_seq 83 | 84 | let permutations_poly : 'a Array.t -> 'a Array.t Seq.t = 85 | fun elems -> 86 | permutations (Array.init (Array.length elems) ~f:(fun x -> x)) 87 | |> Seq.map ~f:(fun indices -> Array.map indices ~f:(fun i -> elems.(i))) 88 | 89 | (* See https://rosettacode.org/wiki/Combinations_with_repetitions#OCaml *) 90 | let rec combinations_with_replacement : int -> 'a list -> 'a list list = 91 | fun k l -> 92 | match (k, l) with 93 | | 0, _ -> [[]] 94 | | _, [] -> [] 95 | | k, x :: xs -> 96 | List.map ~f:(fun xs' -> x :: xs') (combinations_with_replacement (k - 1) l) 97 | @ combinations_with_replacement k xs 98 | -------------------------------------------------------------------------------- /lib/combinat.mli: -------------------------------------------------------------------------------- 1 | open Core 2 | 3 | (** Implementations of combinatorics routines. *) 4 | 5 | val m_partition : int -> int -> Array.Int.t Sequence.t 6 | (** Compute the partitions of an integer {i n} into {i m} parts. See 7 | (Knuth 3b, pg. 2). *) 8 | 9 | val m_partition_with_zeros : int -> int -> Array.Int.t Sequence.t 10 | (** Compute the partitions of an integer {i n} into {i m} parts, 11 | including partitions where some elements are zero. *) 12 | 13 | val permutations : Array.Int.t -> Array.Int.t Sequence.t 14 | (** Compute the unique permutations of an array. See (Knuth 2b, pg. 1). *) 15 | 16 | val permutations_poly : 'a Array.t -> 'a Array.t Sequence.t 17 | 18 | val combinations_with_replacement : int -> 'a list -> 'a list list 19 | -------------------------------------------------------------------------------- /lib/config.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | 3 | type t = 4 | { verbosity: int [@default 0] [@sexp_drop_default] 5 | ; untyped: bool [@default false] [@sexp_drop_default] 6 | ; deduction: bool [@default true] [@sexp_drop_default] 7 | ; infer_base: bool [@default true] [@sexp_drop_default] 8 | ; use_solver: bool [@default false] [@sexp_drop_default] 9 | ; max_exhaustive_depth: int [@default 7] [@sexp_drop_default] 10 | ; check_prob: float 11 | ; flat_cost: bool [@default false] [@sexp_drop_default] } 12 | [@@deriving sexp] 13 | 14 | let default = 15 | { verbosity= 0 16 | ; untyped= false 17 | ; deduction= true 18 | ; infer_base= true 19 | ; use_solver= false 20 | ; max_exhaustive_depth= 7 21 | ; check_prob= 1.5 22 | ; flat_cost= false } 23 | 24 | let of_string (s : string) : t = t_of_sexp (Sexp.of_string (String.strip s)) 25 | 26 | let to_string (c : t) : string = Sexp.to_string_hum (sexp_of_t c) 27 | 28 | let config = ref default 29 | -------------------------------------------------------------------------------- /lib/config.mli: -------------------------------------------------------------------------------- 1 | open Core 2 | 3 | (** Contains runtime configuration for L2. *) 4 | type t = { 5 | (** The logging verbosity. (deprecated) *) 6 | verbosity : int; 7 | 8 | (** Whether to use type-based expression pruning. *) 9 | untyped : bool; 10 | 11 | (** Whether to prune expressions using deduction rules. *) 12 | deduction : bool; 13 | 14 | (** Whether to infer the base cases of folds. *) 15 | infer_base : bool; 16 | 17 | (** Whether to use Z3 to prune expressions. *) 18 | use_solver : bool; 19 | 20 | (** The largest expression that can be used to fill a hole in a hypothesis. *) 21 | max_exhaustive_depth : int; 22 | 23 | check_prob : float; 24 | 25 | flat_cost : bool; 26 | } 27 | 28 | (** The default configuration. *) 29 | val default : t 30 | 31 | include Sexpable.S with type t := t 32 | include Stringable.S with type t := t 33 | 34 | (** The current configuration. *) 35 | val config : t ref 36 | -------------------------------------------------------------------------------- /lib/dune: -------------------------------------------------------------------------------- 1 | (ocamllex lexer_sexp lexer_ml) 2 | 3 | (menhir (modules parser_sexp parser_ml)) 4 | 5 | (library 6 | (name l2) 7 | (public_name l2) 8 | (libraries core core_extended yojson hashcons) 9 | (preprocess (pps ppx_jane)) 10 | (modules (:standard \ Symbolic_execution Automaton Generate_functions))) 11 | -------------------------------------------------------------------------------- /lib/eval.mli: -------------------------------------------------------------------------------- 1 | open Core 2 | open Collections 3 | 4 | exception RuntimeError of Error.t 5 | 6 | exception HitRecursionLimit 7 | 8 | val eval : ?recursion_limit:int -> Value.t Ctx.t -> Expr.t -> Value.t 9 | 10 | val partial_eval : 11 | ?recursion_limit:int -> ?ctx:ExprValue.t Ctx.t -> ExprValue.t -> ExprValue.t 12 | -------------------------------------------------------------------------------- /lib/example.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | open Collections 3 | open Infer 4 | open Util 5 | 6 | type t = Expr.t * Expr.t [@@deriving sexp, compare] 7 | 8 | (** Parse an example from a string. *) 9 | let of_string_exn (s : string) : t = 10 | let lexbuf = Lexing.from_string s in 11 | try Parser_sexp.example_eof Lexer_sexp.token lexbuf with 12 | | Parser_sexp.Error -> raise (Ast.ParseError s) 13 | | Lexer_sexp.SyntaxError _ -> raise (Ast.ParseError s) 14 | | Parsing.Parse_error -> raise (Ast.ParseError s) 15 | 16 | let of_string (s : string) : t Or_error.t = 17 | try Ok (of_string_exn s) with Ast.ParseError s -> 18 | error "Parsing Example.t failed." s [%sexp_of: string] 19 | 20 | (** Convert an example to a string. *) 21 | let to_string (ex : t) : string = 22 | let e1, e2 = ex in 23 | sprintf "%s -> %s" (Expr.to_string e1) (Expr.to_string e2) 24 | 25 | let to_triple = function 26 | | `Apply (`Id name, inputs), result -> (name, inputs, result) 27 | | ex -> failwith (sprintf "Malformed example: %s" (to_string ex)) 28 | 29 | (** Get the name of the target function from a list of examples. *) 30 | let name (exs : t list) : Ast.id = 31 | let names = 32 | List.map exs ~f:(fun ex -> 33 | let name, _, _ = to_triple ex in 34 | name ) 35 | |> List.dedup_and_sort ~compare:String.compare 36 | in 37 | match names with 38 | | [] -> failwith "Example list is empty." 39 | | [name] -> name 40 | | _ :: _ -> failwith "Multiple target names in example list." 41 | 42 | (** Split a list of examples into a list of lists of examples, each of 43 | which represents a distinct function. *) 44 | let split (exs : t list) : (string * t list) list = 45 | List.map exs ~f:(fun ex -> 46 | let name, _, _ = to_triple ex in 47 | (name, ex) ) 48 | |> List.group ~break:(fun (n1, _) (n2, _) -> n1 <> n2) 49 | |> List.map ~f:(fun exs -> 50 | match exs with 51 | | (name, _) :: _ -> (name, List.map exs ~f:Tuple.T2.get2) 52 | | _ -> failwith "Expected a non-empty list." ) 53 | 54 | (** Infer a function signature from input/output examples. *) 55 | let signature ?(ctx = Ctx.empty ()) (examples : t list) : Type.t = 56 | let _, inputs, results = List.map examples ~f:to_triple |> unzip3 in 57 | let res_typ = 58 | match TypedExpr.to_type (infer_exn ctx (`List results)) with 59 | | Type.App_t ("list", [t]) -> t 60 | | t -> failwith (sprintf "Unexpected result type: %s" (Type.to_string t)) 61 | in 62 | let typ = 63 | match inputs with 64 | | args :: _ -> 65 | let num_args = List.length args in 66 | Type.Arrow_t 67 | ( List.range 0 num_args |> List.map ~f:(fun _ -> Infer.fresh_free 0) 68 | , res_typ ) 69 | | [] -> failwith "Example list is empty." 70 | in 71 | let ctx = Ctx.bind ctx (name examples) typ in 72 | let name' = name examples in 73 | List.iter inputs ~f:(fun input -> 74 | let _ = Infer.infer ctx (`Apply (`Id name', input)) in 75 | () ) ; 76 | typ 77 | 78 | let to_vctx (example : t) (arg_names : string list) : Expr.t Ctx.t = 79 | let _, inputs, _ = to_triple example in 80 | List.zip_exn arg_names inputs |> Ctx.of_alist_exn 81 | 82 | let check (examples : (t * Expr.t Ctx.t) list) : bool = 83 | (* Is there a pair of examples such that the outer contexts and LHSs 84 | are equal, but the RHSs are not? *) 85 | not 86 | (List.exists examples ~f:(fun ((lhs, rhs), vctx) -> 87 | List.exists examples ~f:(fun ((lhs', rhs'), vctx') -> 88 | Ctx.equal Expr.equal vctx vctx' && lhs = lhs' && rhs <> rhs' ) )) 89 | -------------------------------------------------------------------------------- /lib/example.mli: -------------------------------------------------------------------------------- 1 | open Core 2 | open Collections 3 | 4 | type t = Expr.t * Expr.t 5 | 6 | include Sexpable.S with type t := t 7 | 8 | val compare : t -> t -> int 9 | 10 | val of_string_exn : string -> t 11 | 12 | val of_string : string -> t Or_error.t 13 | 14 | val to_string : t -> string 15 | 16 | val to_triple : t -> Ast.id * Ast.expr list * Expr.t 17 | 18 | val name : t list -> Ast.id 19 | 20 | val split : t list -> (string * t list) list 21 | 22 | val signature : ?ctx:Infer.Type.t Ctx.t -> t list -> Infer.Type.t 23 | 24 | val to_vctx : t -> string list -> Expr.t Ctx.t 25 | 26 | val check : (t * Expr.t Ctx.t) list -> bool 27 | -------------------------------------------------------------------------------- /lib/example_deduction.mli: -------------------------------------------------------------------------------- 1 | open Core 2 | open Synthesis_common 3 | open Collections 4 | 5 | type example = ExprValue.t list * ExprValue.t [@@deriving sexp] 6 | 7 | val examples_of_file : string -> example list 8 | 9 | val examples_of_channel : In_channel.t -> example list 10 | 11 | val timer : Timer.t 12 | 13 | val push_specs : Deduction.t 14 | -------------------------------------------------------------------------------- /lib/expr.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | open Printf 3 | open Ast 4 | open Collections 5 | open Util 6 | 7 | module Map = Core.Map.Make (struct 8 | type t = expr [@@deriving compare, sexp] 9 | end) 10 | 11 | type t = Ast.expr [@@deriving compare, sexp] 12 | 13 | type id = Ast.id [@@deriving compare, sexp, bin_io] 14 | 15 | (** Module to manage built in operators and their metadata. *) 16 | module Op = struct 17 | module Map = Core.Map.Make (struct 18 | type t = op 19 | 20 | let t_of_sexp = op_of_sexp 21 | 22 | let sexp_of_t = sexp_of_op 23 | 24 | let compare = compare_op 25 | end) 26 | 27 | type t = Ast.op = 28 | | Plus 29 | | Minus 30 | | Mul 31 | | Div 32 | | Mod 33 | | Eq 34 | | Neq 35 | | Lt 36 | | Leq 37 | | Gt 38 | | Geq 39 | | And 40 | | Or 41 | | Not 42 | | If 43 | | RCons 44 | | Cons 45 | | Car 46 | | Cdr 47 | | Tree 48 | | Value 49 | | Children 50 | [@@deriving compare, sexp, bin_io, hash] 51 | 52 | (** Type for storing operator metadata. *) 53 | type metadata = {typ: typ; commut: bool; assoc: bool; str: string; cost: int} 54 | 55 | let equal o1 o2 = compare_op o1 o2 = 0 56 | 57 | let hash = Hashtbl.hash 58 | 59 | let metadata_by_op = 60 | let t s = 61 | let lexbuf = Lexing.from_string s in 62 | try Parser_sexp.typ_eof Lexer_sexp.token lexbuf with 63 | | Parser_sexp.Error -> raise (ParseError s) 64 | | Lexer_sexp.SyntaxError _ -> raise (ParseError s) 65 | | Parsing.Parse_error -> raise (ParseError s) 66 | in 67 | [ ( Plus 68 | , {typ= t "(num, num) -> num"; commut= true; assoc= true; str= "+"; cost= 1} 69 | ) 70 | ; ( Minus 71 | , {typ= t "(num, num) -> num"; commut= false; assoc= false; str= "-"; cost= 1} 72 | ) 73 | ; ( Mul 74 | , {typ= t "(num, num) -> num"; commut= true; assoc= true; str= "*"; cost= 1} 75 | ) 76 | ; ( Div 77 | , {typ= t "(num, num) -> num"; commut= false; assoc= false; str= "/"; cost= 1} 78 | ) 79 | ; ( Mod 80 | , {typ= t "(num, num) -> num"; commut= false; assoc= false; str= "%"; cost= 1} 81 | ) 82 | ; (Eq, {typ= t "(a, a) -> bool"; commut= true; assoc= false; str= "="; cost= 1}) 83 | ; ( Neq 84 | , {typ= t "(a, a) -> bool"; commut= true; assoc= false; str= "!="; cost= 1} ) 85 | ; ( Lt 86 | , {typ= t "(num, num) -> bool"; commut= false; assoc= false; str= "<"; cost= 1} 87 | ) 88 | ; ( Leq 89 | , { typ= t "(num, num) -> bool" 90 | ; commut= false 91 | ; assoc= false 92 | ; str= "<=" 93 | ; cost= 1 } ) 94 | ; ( Gt 95 | , {typ= t "(num, num) -> bool"; commut= false; assoc= false; str= ">"; cost= 1} 96 | ) 97 | ; ( Geq 98 | , { typ= t "(num, num) -> bool" 99 | ; commut= false 100 | ; assoc= false 101 | ; str= ">=" 102 | ; cost= 1 } ) 103 | ; ( And 104 | , {typ= t "(bool, bool) -> bool"; commut= true; assoc= true; str= "&"; cost= 1} 105 | ) 106 | ; ( Or 107 | , {typ= t "(bool, bool) -> bool"; commut= true; assoc= true; str= "|"; cost= 1} 108 | ) 109 | ; ( Not 110 | , {typ= t "(bool) -> bool"; commut= false; assoc= false; str= "~"; cost= 1} ) 111 | ; ( If 112 | , {typ= t "(bool, a, a) -> a"; commut= false; assoc= false; str= "if"; cost= 1} 113 | ) 114 | ; ( RCons 115 | , { typ= t "(list[a], a) -> list[a]" 116 | ; commut= false 117 | ; assoc= false 118 | ; str= "rcons" 119 | ; cost= 1 } ) 120 | ; ( Cons 121 | , { typ= t "(a, list[a]) -> list[a]" 122 | ; commut= false 123 | ; assoc= false 124 | ; str= "cons" 125 | ; cost= 1 } ) 126 | ; ( Car 127 | , {typ= t "(list[a]) -> a"; commut= false; assoc= false; str= "car"; cost= 1} 128 | ) 129 | ; ( Cdr 130 | , { typ= t "(list[a]) -> list[a]" 131 | ; commut= false 132 | ; assoc= false 133 | ; str= "cdr" 134 | ; cost= 1 } ) 135 | ; ( Tree 136 | , { typ= t "(a, list[tree[a]]) -> tree[a]" 137 | ; commut= false 138 | ; assoc= false 139 | ; str= "tree" 140 | ; cost= 1 } ) 141 | ; ( Children 142 | , { typ= t "(tree[a]) -> list[tree[a]]" 143 | ; commut= false 144 | ; assoc= false 145 | ; str= "children" 146 | ; cost= 1 } ) 147 | ; ( Value 148 | , {typ= t "(tree[a]) -> a"; commut= false; assoc= false; str= "value"; cost= 1} 149 | ) ] 150 | |> Map.of_alist_exn 151 | 152 | let all = Map.keys metadata_by_op 153 | 154 | let control = [If] 155 | 156 | let cmp = [Eq; Neq; Lt; Leq; Gt; Geq] 157 | 158 | let logic = [And; Or; Not] 159 | 160 | let list = [Cons; Car; Cdr] 161 | 162 | let tree = [Tree; Children; Value] 163 | 164 | let simple_arith = [Plus; Minus] 165 | 166 | let arith = [Plus; Minus; Mul; Div; Mod] 167 | 168 | let op_by_str = 169 | metadata_by_op |> Map.to_alist 170 | |> List.map ~f:(fun (op, meta) -> (meta.str, op)) 171 | |> String.Map.of_alist_exn 172 | 173 | (** Get operator record from operator. *) 174 | let meta = Map.find_exn metadata_by_op 175 | 176 | let typ op = (meta op).typ 177 | 178 | let arity op = 179 | match (meta op).typ with 180 | | Arrow_t (args, _) -> List.length args 181 | | _ -> failwith "Not a function." 182 | 183 | let assoc op = (meta op).assoc 184 | 185 | let commut op = (meta op).commut 186 | 187 | let cost op = (meta op).cost 188 | 189 | let to_string op = (meta op).str 190 | 191 | let of_string str = String.Map.find_exn op_by_str str 192 | end 193 | 194 | let rec cost ?(op_cost = Op.cost) (e : t) : int = 195 | let sum = List.fold_left ~init:0 ~f:( + ) in 196 | match e with 197 | | `Id _ | `Num _ | `Bool _ -> 1 198 | | `Op (op, args) -> op_cost op + sum (List.map args ~f:cost) 199 | | `List l -> 1 + sum (List.map l ~f:cost) 200 | | `Tree t -> Tree.size t 201 | | `Let (_, a, b) -> 1 + cost a + cost b 202 | | `Lambda (args, body) -> 1 + List.length args + cost body 203 | | `Apply (a, l) -> 1 + cost a + sum (List.map l ~f:cost) 204 | 205 | let size = cost ~op_cost:(fun _ -> 1) 206 | 207 | let normalize ?(bound = String.Set.empty) (expr : t) : expr = 208 | let fresh_name = Fresh.mk_fresh_name_fun () in 209 | let rec norm ctx e = 210 | let norm_all = List.map ~f:(norm ctx) in 211 | match e with 212 | | `Num _ | `Bool _ -> e 213 | | `Id x -> ( 214 | match Ctx.lookup ctx x with 215 | | Some x' -> `Id x' 216 | | None -> if String.Set.mem bound x then `Id x else `Id (fresh_name ()) ) 217 | | `List x -> `List (norm_all x) 218 | | `Tree x -> `Tree (Tree.map x ~f:(norm ctx)) 219 | | `Op (op, args) -> `Op (op, norm_all args) 220 | | `Apply (func, args) -> `Apply (norm ctx func, norm_all args) 221 | | `Let (name, x, y) -> 222 | let name' = fresh_name () in 223 | let ctx' = Ctx.bind ctx name name' in 224 | `Let (name', norm ctx' x, norm ctx' y) 225 | | `Lambda (args, body) -> 226 | let ctx', args' = 227 | List.fold_right args ~init:(ctx, []) ~f:(fun arg (ctx', args') -> 228 | let arg' = fresh_name () in 229 | (Ctx.bind ctx' arg arg', arg' :: args') ) 230 | in 231 | `Lambda (args', norm ctx' body) 232 | in 233 | norm (Ctx.empty ()) expr 234 | 235 | let rec of_value = function 236 | | `Num x -> `Num x 237 | | `Bool x -> `Bool x 238 | | `List x -> `List (List.map ~f:of_value x) 239 | | `Tree x -> `Tree (Tree.map ~f:of_value x) 240 | | `Unit -> failwith "Tried to convert unit to expression." 241 | | `Closure _ -> failwith "Tried to convert closure to expression." 242 | 243 | (** Parse an expression from a string. *) 244 | let of_string_exn ?(syntax = `Sexp) (s : string) : t = 245 | let lexbuf = Lexing.from_string s in 246 | try 247 | match syntax with 248 | | `Sexp -> Parser_sexp.expr_eof Lexer_sexp.token lexbuf 249 | | `Ml -> Parser_ml.expr_ml_eof Lexer_ml.token lexbuf 250 | with 251 | | Parser_sexp.Error -> raise (ParseError s) 252 | | Lexer_sexp.SyntaxError _ -> raise (ParseError s) 253 | | Parser_ml.Error -> raise (ParseError s) 254 | | Lexer_ml.SyntaxError _ -> raise (ParseError s) 255 | | Parsing.Parse_error -> raise (ParseError s) 256 | 257 | let of_string ?(syntax = `Sexp) (s : string) : t Or_error.t = 258 | try Ok (of_string_exn ~syntax s) with ParseError s -> 259 | error "Parsing Expr.t failed." s [%sexp_of: string] 260 | 261 | (** Convert an expression to a string. *) 262 | let rec to_string (expr : t) : string = 263 | let list_to_string l = String.concat ~sep:" " (List.map ~f:to_string l) in 264 | match expr with 265 | | `Num x -> Int.to_string x 266 | | `Bool true -> "#t" 267 | | `Bool false -> "#f" 268 | | `Id x -> x 269 | | `List x -> sprintf "[%s]" (list_to_string x) 270 | | `Tree x -> Tree.to_string x ~str:to_string 271 | | `Op (op, args) -> sprintf "(%s %s)" (Op.to_string op) (list_to_string args) 272 | | `Let (x, y, z) -> sprintf "(let %s %s %s)" x (to_string y) (to_string z) 273 | | `Apply (x, y) -> sprintf "(%s %s)" (to_string x) (list_to_string y) 274 | | `Lambda (args, body) -> 275 | sprintf "(lambda (%s) %s)" (String.concat ~sep:" " args) (to_string body) 276 | 277 | let equal (e1 : t) (e2 : t) = compare_expr e1 e2 = 0 278 | 279 | (** Return true if all the names in an expression are free. *) 280 | let all_abstract (e : t) : bool = 281 | let rec f (b : String.Set.t) (e : t) : bool = 282 | match e with 283 | | `Num _ | `Bool _ | `List [] -> false 284 | | `Id x -> not (String.Set.mem b x) 285 | | `List x -> List.for_all ~f:(f b) x 286 | | `Tree x -> Tree.flatten x |> List.for_all ~f:(f b) 287 | | `Op (_, x) -> List.for_all ~f:(f b) x 288 | | `Let (x, y, z) -> 289 | let b' = String.Set.add b x in 290 | f b' y && f b' z 291 | | `Apply (x, y) -> f b x && List.for_all ~f:(f b) y 292 | | `Lambda (_, x) -> f b x 293 | in 294 | f String.Set.empty e 295 | -------------------------------------------------------------------------------- /lib/exprValue.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | open Collections 3 | 4 | module T = struct 5 | type t = 6 | [ `Unit 7 | | `Num of int 8 | | `Bool of bool 9 | | `List of t list 10 | | `Tree of t Tree.t 11 | | `Closure of t * t Ctx.t 12 | | `Id of Expr.id 13 | | `Let of Expr.id * t * t 14 | | `Lambda of Expr.id list * t 15 | | `Apply of t * t list 16 | | `Op of Expr.Op.t * t list ] 17 | [@@deriving compare, sexp, bin_io] 18 | end 19 | 20 | include T 21 | 22 | let rec to_string (e : t) : string = 23 | let list_to_string l = String.concat ~sep:" " (List.map ~f:to_string l) in 24 | match e with 25 | | `Num x -> Int.to_string x 26 | | `Bool true -> "#t" 27 | | `Bool false -> "#f" 28 | | `Id x -> x 29 | | `List x -> sprintf "[%s]" (list_to_string x) 30 | | `Tree x -> Tree.to_string x ~str:to_string 31 | | `Op (op, args) -> sprintf "(%s %s)" (Expr.Op.to_string op) (list_to_string args) 32 | | `Let (x, y, z) -> sprintf "(let %s %s %s)" x (to_string y) (to_string z) 33 | | `Apply (x, y) -> sprintf "(%s %s)" (to_string x) (list_to_string y) 34 | | `Lambda (args, body) -> 35 | sprintf "(lambda (%s) %s)" (String.concat ~sep:" " args) (to_string body) 36 | | `Closure _ -> "*closure*" 37 | | `Unit -> "unit" 38 | 39 | let rec of_expr (e : Expr.t) : t = 40 | match e with 41 | | `Num x -> `Num x 42 | | `Bool x -> `Bool x 43 | | `Id x -> `Id x 44 | | `List x -> `List (List.map x ~f:of_expr) 45 | | `Tree x -> `Tree (Tree.map x ~f:of_expr) 46 | | `Op (op, args) -> `Op (op, List.map args ~f:of_expr) 47 | | `Let (x, y, z) -> `Let (x, of_expr y, of_expr z) 48 | | `Apply (x, y) -> `Apply (of_expr x, List.map y ~f:of_expr) 49 | | `Lambda (x, y) -> `Lambda (x, of_expr y) 50 | 51 | let rec of_value : Value.t -> t = function 52 | | `Num x -> `Num x 53 | | `Bool x -> `Bool x 54 | | `List x -> `List (List.map x ~f:of_value) 55 | | `Tree x -> `Tree (Tree.map x ~f:of_value) 56 | | `Closure (x, ctx) -> `Closure (of_expr x, Ctx.map ctx ~f:of_value) 57 | | `Unit -> `Unit 58 | 59 | let rec to_expr_exn : t -> Expr.t = function 60 | | `Num x -> `Num x 61 | | `Bool x -> `Bool x 62 | | `List x -> `List (List.map x ~f:to_expr_exn) 63 | | `Tree x -> `Tree (Tree.map x ~f:to_expr_exn) 64 | | `Op (op, args) -> `Op (op, List.map args ~f:to_expr_exn) 65 | | `Let (x, y, z) -> `Let (x, to_expr_exn y, to_expr_exn z) 66 | | `Apply (x, y) -> `Apply (to_expr_exn x, List.map y ~f:to_expr_exn) 67 | | `Lambda (x, y) -> `Lambda (x, to_expr_exn y) 68 | | e -> failwiths "Cannot convert to value." e [%sexp_of: t] 69 | 70 | let rec to_value_exn : t -> Value.t = function 71 | | `Num x -> `Num x 72 | | `Bool x -> `Bool x 73 | | `Op (Expr.Op.Cons, [hd; tl]) as e -> ( 74 | match to_value_exn tl with 75 | | `List tl' -> `List (to_value_exn hd :: tl') 76 | | _ -> failwiths "Cannot convert to value." e [%sexp_of: t] ) 77 | | `List x -> `List (List.map x ~f:to_value_exn) 78 | | `Tree x -> `Tree (Tree.map x ~f:to_value_exn) 79 | | `Closure (x, ctx) -> `Closure (to_expr_exn x, Ctx.map ~f:to_value_exn ctx) 80 | | `Unit -> `Unit 81 | | e -> failwiths "Cannot convert to value." e [%sexp_of: t] 82 | 83 | let to_value : t -> Value.t Or_error.t = 84 | fun e -> Or_error.try_with (fun () -> to_value_exn e) 85 | 86 | include Comparable.Make (T) 87 | -------------------------------------------------------------------------------- /lib/exprValue.mli: -------------------------------------------------------------------------------- 1 | open Core 2 | open Collections 3 | 4 | type t = 5 | [ `Apply of t * t list 6 | | `Bool of bool 7 | | `Closure of t * t Ctx.t 8 | | `Id of Expr.id 9 | | `Lambda of Expr.id list * t 10 | | `Let of Expr.id * t * t 11 | | `List of t list 12 | | `Num of int 13 | | `Op of Expr.Op.t * t list 14 | | `Tree of t Tree.t 15 | | `Unit ] 16 | 17 | include Binable.S with type t := t 18 | 19 | include Sexpable.S with type t := t 20 | 21 | include Comparable.S with type t := t 22 | 23 | val compare : t -> t -> int 24 | 25 | val to_string : t -> String.t 26 | 27 | val of_expr : Expr.t -> t 28 | 29 | val of_value : Value.t -> t 30 | 31 | val to_expr_exn : t -> Expr.t 32 | 33 | val to_value_exn : t -> Value.t 34 | 35 | val to_value : t -> Value.t Or_error.t 36 | -------------------------------------------------------------------------------- /lib/generate_functions.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | open Collections 3 | open Hypothesis 4 | open Infer 5 | open Synthesis_common 6 | open V2_engine 7 | module Sp = Specification 8 | 9 | let rec generate_value : ?max_int:int -> ?max_len:int -> Type.t -> Value.t = 10 | let open Type in 11 | fun ?(max_int = 10) ?(max_len = 5) -> function 12 | | Const_t Num_t -> `Num (Random.int (max_int + 1)) 13 | | App_t ("list", [t]) -> 14 | let len = Random.int (max_int + 1) in 15 | `List (List.init len ~f:(fun _ -> generate_value ~max_int ~max_len t)) 16 | | t -> failwiths "Unsupported type." t [%sexp_of: Type.t] 17 | 18 | let generate_inputs : Type.t -> Value.t list = 19 | let open Type in 20 | function 21 | | Arrow_t (input_ts, _) -> List.map input_ts ~f:generate_value 22 | | t -> failwiths "Not an arrow type." t [%sexp_of: Type.t] 23 | 24 | let generate_expr : cost:int -> Library.t -> Type.t -> Expr.t list = 25 | let module H = Hypothesis in 26 | fun ~cost library type_ -> 27 | let cost_model = V2_engine.default_cost_model in 28 | let initial_hypo = 29 | H.hole cost_model 30 | (Hole.create type_ L2_Generalizer.Symbols.lambda) 31 | Specification.top 32 | in 33 | let gen = V2_engine.L2_Generalizer.With_components.create cost_model library in 34 | let rec loop hypo = 35 | let hypos = Generalizer.generalize_single {cost_model; library} gen hypo in 36 | print_endline "Generalizing:" ; 37 | print_endline (H.to_string hypo) ; 38 | let small_abstract = 39 | List.filter hypos ~f:(fun h -> 40 | H.cost h + (H.holes h |> List.length) <= cost && H.kind h = H.Abstract 41 | ) 42 | in 43 | let concrete = 44 | List.filter hypos ~f:(fun h -> H.cost h >= cost && H.kind h = H.Concrete) 45 | in 46 | if List.length concrete > 0 then concrete |> List.map ~f:H.to_expr 47 | else List.concat_map small_abstract ~f:loop 48 | (* let choices = *) 49 | (* (if List.length small_abstract > 0 then [`Abstract] else []) @ *) 50 | (* (if List.length concrete > 0 then [`Concrete] else []) *) 51 | (* in *) 52 | (* printf "%d\n" (List.length choices); *) 53 | (* flush stdout; *) 54 | (* match List.random choices with *) 55 | (* | Some `Abstract -> *) 56 | (* List.permute small_abstract *) 57 | (* |> List.find_map ~f:loop *) 58 | (* | Some `Concrete -> Some (Option.value_exn (List.random concrete) |> H.to_expr) *) 59 | (* | None -> None *) 60 | in 61 | loop initial_hypo 62 | 63 | let generate_exprs : cost:int -> Library.t -> Type.t -> Expr.t Sequence.t = 64 | let module H = Hypothesis in 65 | let module Seq = Sequence in 66 | fun ~cost library type_ -> 67 | let cost_model = V2_engine.default_cost_model in 68 | let initial_hypo = 69 | H.hole cost_model 70 | (Hole.create type_ L2_Generalizer.Symbols.lambda) 71 | Specification.top 72 | in 73 | let gen = V2_engine.L2_Generalizer.With_components.create cost_model library in 74 | let rec loop hypo = 75 | let hypos = Generalizer.generalize_single {cost_model; library} gen hypo in 76 | print_endline "Generalizing:" ; 77 | print_endline (H.to_string hypo) ; 78 | let small_abstract = 79 | List.filter hypos ~f:(fun h -> 80 | H.cost h + (H.holes h |> List.length) <= cost && H.kind h = H.Abstract 81 | ) 82 | in 83 | let concrete = 84 | List.filter hypos ~f:(fun h -> H.cost h = cost && H.kind h = H.Concrete) 85 | in 86 | if List.length concrete > 0 then Seq.of_list concrete 87 | else Seq.concat_map (Seq.of_list small_abstract) ~f:loop 88 | (* let choices = *) 89 | (* (if List.length small_abstract > 0 then [`Abstract] else []) @ *) 90 | (* (if List.length concrete > 0 then [`Concrete] else []) *) 91 | (* in *) 92 | (* printf "%d\n" (List.length choices); *) 93 | (* flush stdout; *) 94 | (* match List.random choices with *) 95 | (* | Some `Abstract -> *) 96 | (* List.permute small_abstract *) 97 | (* |> List.find_map ~f:loop *) 98 | (* | Some `Concrete -> Some (Option.value_exn (List.random concrete) |> H.to_expr) *) 99 | (* | None -> None *) 100 | in 101 | loop initial_hypo |> Seq.map ~f:H.to_expr 102 | 103 | let generate_spec : Value.t list list -> Library.t -> Type.t -> Expr.t -> Sp.t = 104 | fun inputs l t e -> 105 | try 106 | List.map inputs ~f:(fun ins -> 107 | let ins = List.map ins ~f:Expr.of_value in 108 | let out = 109 | Eval.eval ~recursion_limit:100 (ref l.Library.value_ctx) (`Apply (e, ins)) 110 | in 111 | (ins, out) ) 112 | |> FunctionExamples.of_input_output_list_exn |> FunctionExamples.to_spec 113 | with 114 | | Eval.HitRecursionLimit -> Sp.bottom 115 | | Eval.RuntimeError err -> Sp.bottom 116 | 117 | let is_interesting : Sp.t -> bool = 118 | fun spec -> 119 | match Sp.spec spec with 120 | | Sp.Bottom -> false 121 | | FunctionExamples.FunctionExamples exs -> 122 | let outs = FunctionExamples.to_list exs |> List.map ~f:Tuple.T2.get2 in 123 | not (List.all_equal outs) 124 | | _ -> true 125 | 126 | type out = {function_: Expr.t; spec: Sp.t} [@@deriving sexp] 127 | 128 | let cmd = 129 | let spec = 130 | let open Command.Spec in 131 | empty 132 | +> flag "-v" ~aliases:["--verbose"] no_arg ~doc:" print verbose output" 133 | +> anon ("max-cost" %: int) 134 | +> anon ("library" %: file) 135 | +> anon ("type" %: string) 136 | +> anon ("out-dir" %: string) 137 | in 138 | let run verbose max_cost library_fn type_str out_dir () = 139 | let library = Library.from_file_exn library_fn in 140 | let type_ = Type.of_string_exn type_str in 141 | Status.disable () ; 142 | let type_str = Type.to_string type_ in 143 | let num_examples = 10 in 144 | let inputs = List.init num_examples ~f:(fun _ -> generate_inputs type_) in 145 | let discarded = ref 0 in 146 | let duplicates = ref 0 in 147 | (* Memoizer.to_flat_sequence memoizer ~min_cost:0 ~max_cost initial_hypo *) 148 | 149 | (* Sequence.repeat () *) 150 | 151 | (* |> Sequence.map ~f:(fun _ -> *) 152 | (* generate_expr ~cost:max_cost library type_ *) 153 | (* ) *) 154 | (* |> Sequence.concat_map ~f:Sequence.of_list *) 155 | generate_exprs ~cost:max_cost library type_ 156 | |> Sequence.map ~f:(fun e -> 157 | {function_= e; spec= generate_spec inputs library type_ e} ) 158 | |> Sequence.mapi ~f:(fun i out -> 159 | if i % 100 = 0 then ( 160 | printf "%d discarded\n" !discarded ; 161 | printf "%d duplicates\n" !duplicates ) ; 162 | out ) 163 | |> Sequence.filter ~f:(fun x -> 164 | if is_interesting x.spec then true else ( incr discarded ; false ) ) 165 | |> Sequence.unfold_with ~init:Sp.Set.empty ~f:(fun specs x -> 166 | let open Sequence.Step in 167 | if Set.mem specs x.spec then ( incr duplicates ; Skip specs ) 168 | else Yield (x, Set.add specs x.spec) ) 169 | |> Sequence.inspect ~f:(fun out -> 170 | print_endline (Expr.to_string out.function_) ; 171 | print_endline (Specification.to_string out.spec) ; 172 | print_newline () ) 173 | |> Sequence.iteri ~f:(fun i out -> 174 | let fn = sprintf "%s/%s_%d.sexp" out_dir type_str i in 175 | Out_channel.with_file fn ~f:(fun ch -> 176 | [%sexp_of: out] out 177 | |> Sexp.to_string_hum |> Out_channel.output_string ch ) ; 178 | let name = sprintf "f%d" i in 179 | let exs = 180 | match Sp.spec out.spec with FunctionExamples.FunctionExamples exs -> 181 | FunctionExamples.to_list exs 182 | |> List.map ~f:(fun ((_, ins), out) -> 183 | ( `Apply (`Id name, List.map ins ~f:Expr.of_value) 184 | , Expr.of_value out ) ) 185 | in 186 | let testcase = 187 | Testcase.{name; desc= ""; case= Examples (exs, []); blacklist= []} 188 | in 189 | let fn = sprintf "%s/%s_%d.json" out_dir type_str i in 190 | Testcase.to_file_exn ~filename:fn testcase ) 191 | in 192 | Command.basic ~summary:"Generate functions." spec run 193 | -------------------------------------------------------------------------------- /lib/higher_order_deduction.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | open Collections 3 | open Hypothesis 4 | module Sp = Specification 5 | module Sk = Skeleton 6 | 7 | let spec_err name spec = 8 | failwiths "Unexpected spec for return value of function." (name, spec) 9 | [%sexp_of: Ast.id * Sp.t] 10 | 11 | let input_err name inp = 12 | failwiths "Unexpected input value for function." (name, inp) 13 | [%sexp_of: Ast.id * Value.t] 14 | 15 | let ret_err name ret = 16 | failwiths "Unexpected return value of function." (name, ret) 17 | [%sexp_of: Ast.id * Value.t] 18 | 19 | let lookup_err name id = 20 | failwiths "Variable name not present in context." (name, id) 21 | [%sexp_of: Ast.id * StaticDistance.t] 22 | 23 | module type Deduce_2_intf = sig 24 | val name : string 25 | 26 | val examples_of_io : 27 | Value.t -> Value.t -> ((Value.t * Value.t) list, unit) Result.t 28 | end 29 | 30 | module Make_deduce_2 (M : Deduce_2_intf) = struct 31 | let lambda_spec collection_id parent_spec = 32 | let open Result.Monad_infix in 33 | match Sp.data parent_spec with 34 | | Examples.Examples exs -> ( 35 | let m_hole_exs = 36 | List.map (Examples.to_list exs) ~f:(fun (ctx, out_v) -> 37 | let in_v = 38 | match StaticDistance.Map.find ctx collection_id with 39 | | Some in_v -> in_v 40 | | None -> lookup_err M.name collection_id 41 | in 42 | Result.map (M.examples_of_io in_v out_v) ~f:(fun io -> 43 | List.map io ~f:(fun (i, o) -> ((ctx, [i]), o)) ) ) 44 | |> Result.all >>| List.concat 45 | >>= fun hole_exs -> 46 | Result.map_error (FunctionExamples.of_list hole_exs) ~f:(fun _ -> ()) 47 | in 48 | match m_hole_exs with 49 | | Ok hole_exs -> FunctionExamples.to_spec hole_exs 50 | | Error () -> Sp.bottom ) 51 | | Sp.Top -> Sp.top 52 | | Sp.Bottom -> Sp.bottom 53 | | Inputs.Inputs _ -> Sp.top 54 | | _ -> spec_err M.name parent_spec 55 | 56 | let deduce spec args = 57 | match args with 58 | | [list; lambda] when Sp.equal (Sk.spec lambda) Sp.top -> ( 59 | match Sk.ast list with 60 | | Sk.Id (Sk.Id.StaticDistance sd) -> 61 | let child_spec = lambda_spec sd spec in 62 | [list; Sk.replace_spec lambda child_spec] 63 | | _ -> args ) 64 | | _ -> args 65 | end 66 | 67 | module type Deduce_fold_intf = sig 68 | val name : string 69 | 70 | val is_base_case : Value.t -> bool 71 | end 72 | 73 | module Make_deduce_fold (M : Deduce_fold_intf) = struct 74 | let base_spec collection_id parent_spec = 75 | match Sp.data parent_spec with 76 | | Examples.Examples exs -> ( 77 | let exs = Examples.to_list exs in 78 | let m_base_exs = 79 | List.filter exs ~f:(fun (ctx, _) -> 80 | match StaticDistance.Map.find ctx collection_id with 81 | | Some v -> M.is_base_case v 82 | | None -> lookup_err (M.name ^ "-base-case") collection_id ) 83 | |> Examples.of_list 84 | in 85 | match m_base_exs with 86 | | Ok base_exs -> Examples.to_spec base_exs 87 | | Error _ -> Sp.bottom ) 88 | | Sp.Top -> Sp.top 89 | | Sp.Bottom -> Sp.bottom 90 | | _ -> spec_err (M.name ^ "-base-case") parent_spec 91 | 92 | let deduce spec args = 93 | match args with 94 | | [input; lambda; base] -> ( 95 | match Sk.ast input with 96 | | Sk.Id (Sk.Id.StaticDistance sd) -> 97 | let b_spec = Sk.spec base in 98 | let b_spec = 99 | if Sp.equal b_spec Sp.top then base_spec sd spec else b_spec 100 | in 101 | [input; lambda; Sk.replace_spec base b_spec] 102 | | _ -> args ) 103 | | _ -> args 104 | end 105 | 106 | module Deduce_map = Make_deduce_2 (struct 107 | let name = "map" 108 | 109 | let examples_of_io in_v out_v = 110 | let out = match out_v with `List out -> out | _ -> ret_err name out_v in 111 | let inp = match in_v with `List inp -> inp | _ -> input_err name in_v in 112 | Option.value_map (List.zip inp out) ~default:(Error ()) ~f:(fun io -> Ok io) 113 | end) 114 | 115 | module Deduce_mapt = Make_deduce_2 (struct 116 | let name = "mapt" 117 | 118 | let examples_of_io in_v out_v = 119 | let out = match out_v with `Tree out -> out | _ -> ret_err name out_v in 120 | let inp = match in_v with `Tree inp -> inp | _ -> input_err name in_v in 121 | Option.map (Tree.zip inp out) ~f:(fun io -> Ok (Tree.flatten io)) 122 | |> Option.value ~default:(Error ()) 123 | end) 124 | 125 | module Deduce_filter = Make_deduce_2 (struct 126 | let name = "filter" 127 | 128 | let rec f = function 129 | (* If there are no inputs and no outputs, then there are no 130 | examples, but filter is valid. *) 131 | | [], [] -> Some [] 132 | (* If there are some inputs and no outputs, then the inputs 133 | must have been filtered. *) 134 | | (_ :: _ as inputs), [] -> 135 | Some (List.map inputs ~f:(fun i -> (i, `Bool false))) 136 | (* If there are some outputs and no inputs, then filter is 137 | not valid. *) 138 | | [], _ :: _ -> None 139 | | i :: is, o :: os when i = o -> 140 | Option.map (f (is, os)) ~f:(fun exs -> (i, `Bool true) :: exs) 141 | | i :: is, (_ :: _ as outputs) -> 142 | Option.map (f (is, outputs)) ~f:(fun exs -> (i, `Bool false) :: exs) 143 | 144 | let examples_of_io in_v out_v = 145 | let out = match out_v with `List out -> out | _ -> ret_err name out_v in 146 | let inp = match in_v with `List inp -> inp | _ -> input_err name in_v in 147 | Option.value_map (f (inp, out)) ~default:(Error ()) ~f:(fun io -> Ok io) 148 | end) 149 | 150 | module Deduce_foldl = Make_deduce_fold (struct 151 | let name = "foldl" 152 | 153 | let is_base_case v = v = `List [] 154 | end) 155 | 156 | module Deduce_foldr = Make_deduce_fold (struct 157 | let name = "foldr" 158 | 159 | let is_base_case v = v = `List [] 160 | end) 161 | 162 | module Deduce_foldt = Make_deduce_fold (struct 163 | let name = "foldt" 164 | 165 | let is_base_case v = v = `Tree Tree.Empty 166 | end) 167 | 168 | let deduce_lambda lambda spec = 169 | let num_args, body = lambda in 170 | if Sp.equal (Sk.spec body) Sp.top then 171 | let child_spec = Sp.increment_scope spec in 172 | let child_spec = 173 | match Sp.data child_spec with 174 | | FunctionExamples.FunctionExamples exs -> 175 | let arg_names = StaticDistance.args num_args in 176 | let child_exs = 177 | FunctionExamples.to_list exs 178 | |> List.map ~f:(fun ((in_ctx, in_args), out) -> 179 | let value_ctx = 180 | StaticDistance.Map.of_alist_exn 181 | (List.zip_exn arg_names in_args) 182 | in 183 | let in_ctx = 184 | StaticDistance.Map.merge value_ctx in_ctx ~f:(fun ~key:_ v -> 185 | match v with `Both (x, _) | `Left x | `Right x -> Some x ) 186 | in 187 | (in_ctx, out) ) 188 | |> Examples.of_list_exn 189 | in 190 | Examples.to_spec child_exs 191 | | Sp.Bottom -> Sp.bottom 192 | | Sp.Top -> Sp.top 193 | | Inputs.Inputs _ -> Sp.top 194 | | _ -> spec_err "" spec 195 | in 196 | (num_args, Sk.replace_spec body child_spec) 197 | else lambda 198 | 199 | let rec push_specs (skel : Skeleton.t) : Skeleton.t Option.t = 200 | let open Option.Monad_infix in 201 | let spec = Sk.spec skel in 202 | match Sk.ast skel with 203 | | Sk.Num _ | Sk.Bool _ | Sk.Id _ | Sk.Hole _ -> 204 | if Sp.equal spec Sp.bottom then None else Some skel 205 | | Sk.List l -> 206 | let m_l = List.map l ~f:push_specs |> Option.all in 207 | m_l >>| fun l -> Sk.list l spec 208 | | Sk.Tree t -> 209 | let m_t = Tree.map t ~f:push_specs |> Tree.all in 210 | m_t >>| fun t -> Sk.tree t spec 211 | | Sk.Let {bound; body} -> 212 | let m_bound = push_specs bound in 213 | let m_body = push_specs body in 214 | m_bound >>= fun bound -> m_body >>| fun body -> Sk.let_ bound body spec 215 | | Sk.Lambda {num_args; body} -> 216 | let num_args, body = deduce_lambda (num_args, body) spec in 217 | let m_body = push_specs body in 218 | m_body >>| fun body -> Sk.lambda num_args body spec 219 | | Sk.Op {op; args} -> 220 | let m_args = List.map args ~f:push_specs |> Option.all in 221 | m_args >>| fun args -> Sk.op op args spec 222 | | Sk.Apply {func; args} -> 223 | let args = 224 | match Sk.ast func with 225 | | Sk.Id (Sk.Id.Name "map") -> Deduce_map.deduce spec args 226 | | Sk.Id (Sk.Id.Name "mapt") -> Deduce_mapt.deduce spec args 227 | | Sk.Id (Sk.Id.Name "filter") -> Deduce_filter.deduce spec args 228 | | Sk.Id (Sk.Id.Name "foldl") -> Deduce_foldl.deduce spec args 229 | | Sk.Id (Sk.Id.Name "foldr") -> Deduce_foldr.deduce spec args 230 | | Sk.Id (Sk.Id.Name "foldt") -> Deduce_foldt.deduce spec args 231 | | _ -> args 232 | in 233 | let m_args = 234 | if List.exists args ~f:(fun a -> Sp.equal (Sk.spec a) Sp.bottom) then None 235 | else Option.all (List.map args ~f:push_specs) 236 | in 237 | let m_func = push_specs func in 238 | m_args >>= fun args -> m_func >>| fun func -> Sk.apply func args spec 239 | -------------------------------------------------------------------------------- /lib/higher_order_deduction.mli: -------------------------------------------------------------------------------- 1 | open Synthesis_common 2 | 3 | val push_specs : Deduction.t 4 | -------------------------------------------------------------------------------- /lib/infer.mli: -------------------------------------------------------------------------------- 1 | open Core 2 | open Ast 3 | open Collections 4 | 5 | exception TypeError of Error.t 6 | 7 | val total_infer_time : Time.Span.t ref 8 | 9 | module Type : sig 10 | type const = const_typ = Num_t | Bool_t 11 | 12 | type level = int 13 | 14 | type t = typ = 15 | | Const_t of const_typ 16 | | App_t of id * typ list 17 | | Arrow_t of typ list * typ 18 | | Var_t of var_typ ref 19 | 20 | and var = var_typ = Free of int * level | Link of typ | Quant of string 21 | 22 | include Sexpable.S with type t := t 23 | 24 | val compare : t -> t -> int 25 | 26 | val equal : t -> t -> bool 27 | 28 | val nesting_depth : t -> int 29 | 30 | val normalize : t -> t 31 | 32 | val are_unifiable : t -> t -> bool 33 | 34 | val arity : t -> int 35 | 36 | val of_string_exn : string -> t 37 | 38 | val of_string : string -> t Or_error.t 39 | 40 | val to_string : t -> string 41 | 42 | val of_expr : ?ctx:t String.Map.t -> Expr.t -> t * t Int.Map.t 43 | 44 | val num : t 45 | 46 | val bool : t 47 | 48 | val list : t -> t 49 | 50 | val tree : t -> t 51 | 52 | val quant : id -> t 53 | 54 | val free : int -> level -> t 55 | 56 | val arrow1 : t -> t -> t 57 | 58 | val arrow2 : t -> t -> t -> t 59 | end 60 | 61 | module Unifier : sig 62 | type t = Type.t Int.Map.t 63 | 64 | include Sexpable.S with type t := t 65 | 66 | val empty : t 67 | 68 | val apply : t -> Type.t -> Type.t 69 | 70 | val compose : outer:t -> inner:t -> t 71 | 72 | val equal : t -> t -> bool 73 | 74 | val relevant_to : t -> Type.t -> t 75 | 76 | val of_types_exn : Type.t -> Type.t -> t 77 | 78 | val of_types : Type.t -> Type.t -> t option 79 | 80 | val to_alist : t -> (int * Type.t) list 81 | 82 | val of_alist_exn : (int * Type.t) list -> t 83 | 84 | val to_string : t -> string 85 | end 86 | 87 | module ImmutableType : sig 88 | type t = 89 | | Const_i of const_typ 90 | | App_i of id * t list 91 | | Arrow_i of t list * t 92 | | Quant_i of string 93 | | Free_i of int * level 94 | 95 | include Sexpable.S with type t := t 96 | 97 | module Table : Hashtbl.S with type key = t 98 | 99 | val compare : t -> t -> int 100 | 101 | val hash : t -> int 102 | 103 | val of_type : Type.t -> t 104 | 105 | val to_type : t -> Type.t 106 | end 107 | 108 | module TypedExpr : sig 109 | type t = 110 | | Num of int * Type.t 111 | | Bool of bool * Type.t 112 | | List of t list * Type.t 113 | | Tree of t Tree.t * Type.t 114 | | Id of id * Type.t 115 | | Let of (id * t * t) * Type.t 116 | | Lambda of (id list * t) * Type.t 117 | | Apply of (t * t list) * Type.t 118 | | Op of (Expr.Op.t * t list) * Type.t 119 | 120 | include Comparable.S with type t := t 121 | 122 | include Sexpable.S with type t := t 123 | 124 | val normalize : t -> t 125 | 126 | val map : f:(Type.t -> Type.t) -> t -> t 127 | 128 | val to_expr : t -> Expr.t 129 | 130 | val to_type : t -> Type.t 131 | 132 | val to_string : t -> string 133 | end 134 | 135 | val fresh_free : int -> Type.t 136 | 137 | val normalize : Type.t -> Type.t 138 | 139 | val occurs : int -> int -> Type.t -> unit 140 | 141 | val generalize : int -> Type.t -> Type.t 142 | 143 | val instantiate : ?ctx:Type.t Ctx.t -> int -> Type.t -> Type.t 144 | 145 | val unify_exn : Type.t -> Type.t -> unit 146 | 147 | val unify : Type.t -> Type.t -> Type.t option 148 | 149 | val is_unifiable : Type.t -> Type.t -> bool 150 | 151 | val typeof : Type.t Ctx.t -> int -> Expr.t -> TypedExpr.t 152 | 153 | val stdlib_tctx : Type.t Ctx.t 154 | 155 | val infer_exn : Type.t Ctx.t -> Expr.t -> TypedExpr.t 156 | 157 | val infer : Type.t Ctx.t -> Expr.t -> TypedExpr.t Or_error.t 158 | 159 | val typed_expr_of_string : string -> TypedExpr.t 160 | 161 | val stdlib_names : String.Set.t 162 | 163 | val free : ?bound:String.Set.t -> TypedExpr.t -> (string * Type.t) list 164 | -------------------------------------------------------------------------------- /lib/input_deduction.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | open Collections 3 | open Hypothesis 4 | module Sk = Skeleton 5 | module Sp = Specification 6 | 7 | let get_curr_spec : Sp.t -> Sk.t -> Sp.t = 8 | fun parent_spec sk -> 9 | let curr_spec = Sk.spec sk in 10 | if Sp.equal Sp.top curr_spec then parent_spec else curr_spec 11 | 12 | let get_child_spec : Sp.t -> Sk.t -> Sp.t = 13 | fun parent_spec sk -> 14 | let sp = Sk.spec sk in 15 | match sp.Sp.data with 16 | | Examples.Examples exs -> Inputs.of_examples exs |> Inputs.to_spec 17 | | Inputs.Inputs _ -> sp 18 | | _ -> parent_spec 19 | 20 | let rec push_specs parent_spec sk = 21 | let curr_spec = get_curr_spec parent_spec sk in 22 | let child_spec = get_child_spec parent_spec sk in 23 | match Sk.ast sk with 24 | | Sk.Num _ | Sk.Bool _ | Sk.Id _ | Sk.Hole _ -> Sk.replace_spec sk curr_spec 25 | | Sk.List l -> Sk.list (List.map l ~f:(push_specs child_spec)) curr_spec 26 | | Sk.Tree t -> Sk.tree (Tree.map t ~f:(push_specs child_spec)) curr_spec 27 | | Sk.Let {bound; body} -> 28 | (* Let introduces a new scope, so we can't use the parent 29 | context. *) 30 | let bound' = push_specs Sp.top bound in 31 | let body' = push_specs Sp.top body in 32 | Sk.let_ bound' body' curr_spec 33 | | Sk.Lambda {num_args; body} -> 34 | (* Lambdas introduce a new scope, so we can't use the parent 35 | context. Also, we can't use Inputs specs on function typed 36 | skeletons. *) 37 | Sk.lambda num_args (push_specs Sp.top body) (Sk.spec sk) 38 | | Sk.Op {op; args} -> 39 | Sk.op op (List.map args ~f:(push_specs child_spec)) curr_spec 40 | | Sk.Apply {func; args} -> 41 | let func' = push_specs child_spec func in 42 | let args' = List.map ~f:(push_specs child_spec) args in 43 | Sk.apply func' args' curr_spec 44 | 45 | let push_specs : Synthesis_common.Deduction.t = 46 | fun sk -> push_specs Sp.top sk |> Option.some 47 | -------------------------------------------------------------------------------- /lib/input_deduction.mli: -------------------------------------------------------------------------------- 1 | val push_specs : Synthesis_common.Deduction.t 2 | -------------------------------------------------------------------------------- /lib/lexer_ml.mll: -------------------------------------------------------------------------------- 1 | { 2 | open Parser_ml 3 | 4 | exception SyntaxError of string 5 | let syntax_error char = raise (SyntaxError ("Unexpected character: " ^ char)) 6 | } 7 | 8 | let white = [' ' '\t' '\n' '\r']+ 9 | let id = ['a'-'z' 'A'-'Z' '_'] ['a'-'z' 'A'-'Z' '0'-'9' '_' ''']* 10 | 11 | rule token = parse 12 | | white { token lexbuf } (* Eat whitespace. *) 13 | | "(*" { comment lexbuf } 14 | | "let" { LET } 15 | | "let rec" { LET } 16 | | "builtin" { BUILTIN } 17 | | "in" { IN } 18 | | "if" { IF } 19 | | "then" { THEN } 20 | | "else" { ELSE } 21 | | "fun" { FUN } 22 | | "||" { OR } 23 | | "&&" { AND } 24 | | "not" { NOT } 25 | | "car" { CAR } 26 | | "cdr" { CDR } 27 | | "tree" { TREE } 28 | | "children" { CHILDREN } 29 | | "value" { VALUE } 30 | | "rcons" { RCONS } 31 | | "+" { ADD } 32 | | "-" { SUB } 33 | | "*" { MUL } 34 | | "/" { DIV } 35 | | "%" { MOD } 36 | | "=" { EQ } 37 | | "<>" { NEQ } 38 | | "!=" { NEQ } 39 | | ">" { GT } 40 | | ">=" { GE } 41 | | "<" { LT } 42 | | "<=" { LE } 43 | | "&" { AMP } 44 | | "|" { BAR } 45 | | "~" { NOT } 46 | | "::" { CONS } 47 | | "cons" { CONS } 48 | | ";" { SEMI } 49 | | "->" { ARROW } 50 | | '{' { LCBRACKET } 51 | | '}' { RCBRACKET } 52 | | "#t" { BOOL true } 53 | | "#f" { BOOL false } 54 | | "true" { BOOL true } 55 | | "false" { BOOL false } 56 | | '(' { LPAREN } 57 | | ')' { RPAREN } 58 | | '[' { LBRACKET } 59 | | ']' { RBRACKET } 60 | | ',' { COMMA } 61 | | id as text { ID text } 62 | | '-'?['0'-'9']+ as num { NUM (int_of_string num) } 63 | | eof { EOF } 64 | | _ { syntax_error (Lexing.lexeme lexbuf) } 65 | and comment = parse 66 | | "*)" { token lexbuf } 67 | | _ { comment lexbuf } 68 | 69 | -------------------------------------------------------------------------------- /lib/lexer_sexp.mll: -------------------------------------------------------------------------------- 1 | { 2 | open Parser_sexp 3 | 4 | exception SyntaxError of string 5 | let syntax_error char = raise (SyntaxError ("Unexpected character: " ^ char)) 6 | } 7 | 8 | let white = [' ' '\t' '\n' '\r']+ 9 | let id = ['a'-'z' 'A'-'Z' '_'] ['a'-'z' 'A'-'Z' '0'-'9' '_' ''']* 10 | 11 | rule token = parse 12 | | white { token lexbuf } (* Eat whitespace. *) 13 | | "let" { LET } 14 | | "if" { IF } 15 | | "lambda" { LAMBDA } 16 | | "forall" { FORALL } 17 | | "||" { OR } 18 | | "&&" { AND } 19 | | "not" { NOT } 20 | | "car" { CAR } 21 | | "cdr" { CDR } 22 | | "tree" { TREE } 23 | | "children" { CHILDREN } 24 | | "value" { VALUE } 25 | | "rcons" { RCONS } 26 | | "+" { ADD } 27 | | "-" { SUB } 28 | | "*" { MUL } 29 | | "/" { DIV } 30 | | "%" { MOD } 31 | | "=" { EQ } 32 | | "<>" { NEQ } 33 | | "!=" { NEQ } 34 | | ">" { GT } 35 | | ">=" { GE } 36 | | "<" { LT } 37 | | "<=" { LE } 38 | | "&" { AMP } 39 | | "|" { BAR } 40 | | "~" { NOT } 41 | | "::" { CONS } 42 | | "cons" { CONS } 43 | | "->" { ARROW } 44 | | '{' { LCBRACKET } 45 | | '}' { RCBRACKET } 46 | | "#t" { BOOL true } 47 | | "#f" { BOOL false } 48 | | "true" { BOOL true } 49 | | "false" { BOOL false } 50 | | '(' { LPAREN } 51 | | ')' { RPAREN } 52 | | '[' { LBRACKET } 53 | | ']' { RBRACKET } 54 | | ',' { COMMA } 55 | | id as text { ID text } 56 | | '-'?['0'-'9']+ as num { NUM (int_of_string num) } 57 | | eof { EOF } 58 | | _ { syntax_error (Lexing.lexeme lexbuf) } 59 | 60 | -------------------------------------------------------------------------------- /lib/library.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | open Infer 3 | module SMap = String.Map 4 | 5 | type t = 6 | { exprs: (string * Expr.t) list 7 | ; expr_ctx: Expr.t SMap.t 8 | ; value_ctx: Value.t SMap.t 9 | ; exprvalue_ctx: ExprValue.t SMap.t 10 | ; type_ctx: Type.t SMap.t 11 | ; builtins: Expr.Op.t list } 12 | 13 | let empty = 14 | { exprs= [] 15 | ; expr_ctx= SMap.empty 16 | ; value_ctx= SMap.empty 17 | ; exprvalue_ctx= SMap.empty 18 | ; type_ctx= SMap.empty 19 | ; builtins= [] } 20 | 21 | let from_channel_exn : file:string -> In_channel.t -> t = 22 | fun ~file ch -> 23 | let exprs_and_builtins = 24 | let lexbuf = Lexing.from_channel ch in 25 | try Parser_ml.toplevel_ml_eof Lexer_ml.token lexbuf with 26 | | Parser_ml.Error | Parsing.Parse_error -> 27 | let err = 28 | let open Lexing in 29 | let pos = lexbuf.lex_curr_p in 30 | sprintf "Syntax error in library file '%s'. (line: %d, col: %d)" 31 | pos.pos_fname pos.pos_lnum (pos.pos_cnum - pos.pos_bol) 32 | in 33 | failwith err 34 | | Lexer_ml.SyntaxError err -> 35 | Error.failwiths "Parsing failed." (file, err) [%sexp_of: string * string] 36 | in 37 | let exprs, builtins = 38 | List.partition_map exprs_and_builtins ~f:(function 39 | | `Bind b -> `Fst b 40 | | `Builtin bs -> `Snd bs ) 41 | in 42 | let builtins = List.concat builtins in 43 | let expr_ctx = 44 | List.fold_left exprs ~init:SMap.empty ~f:(fun m (n, e) -> 45 | SMap.set m ~key:n ~data:e ) 46 | in 47 | let value_ctx = 48 | List.fold_left exprs ~init:SMap.empty ~f:(fun ctx (name, expr) -> 49 | let ctx_ref = ref ctx in 50 | let value = Eval.eval ctx_ref (`Let (name, expr, `Id name)) in 51 | SMap.set !ctx_ref ~key:name ~data:value ) 52 | in 53 | let exprvalue_ctx = 54 | List.fold_left exprs ~init:SMap.empty ~f:(fun ctx (name, expr) -> 55 | let ctx_ref = ref ctx in 56 | let value = 57 | Eval.partial_eval ~ctx:ctx_ref 58 | (`Let (name, ExprValue.of_expr expr, `Id name)) 59 | in 60 | SMap.set !ctx_ref ~key:name ~data:value ) 61 | in 62 | let type_ctx = 63 | List.fold_left exprs ~init:SMap.empty ~f:(fun ctx (name, expr) -> 64 | let type_ = 65 | try 66 | let t, _ = Type.of_expr ~ctx (`Let (name, expr, `Id name)) in 67 | generalize (-1) t |> normalize 68 | with TypeError err -> Error.raise err 69 | in 70 | SMap.set ctx ~key:name ~data:type_ ) 71 | in 72 | {exprs; expr_ctx; value_ctx; exprvalue_ctx; type_ctx; builtins} 73 | 74 | let from_channel : file:string -> In_channel.t -> t Or_error.t = 75 | fun ~file ch -> Or_error.try_with (fun () -> from_channel_exn ~file ch) 76 | 77 | let from_file_exn : string -> t = 78 | fun fn -> In_channel.with_file fn ~f:(from_channel_exn ~file:fn) 79 | 80 | let from_file : string -> t Or_error.t = 81 | fun fn -> Or_error.try_with (fun () -> from_file_exn fn) 82 | 83 | let filter_keys : t -> f:(string -> bool) -> t = 84 | fun t ~f -> 85 | { t with 86 | exprs= List.filter ~f:(fun (name, _) -> f name) t.exprs 87 | ; expr_ctx= Map.filter_keys t.expr_ctx ~f 88 | ; value_ctx= Map.filter_keys t.value_ctx ~f 89 | ; exprvalue_ctx= Map.filter_keys t.exprvalue_ctx ~f 90 | ; type_ctx= Map.filter_keys t.type_ctx ~f } 91 | -------------------------------------------------------------------------------- /lib/library.mli: -------------------------------------------------------------------------------- 1 | open Core 2 | 3 | type t = 4 | { exprs: (string * Expr.t) list 5 | ; expr_ctx: Expr.t String.Map.t 6 | ; value_ctx: Value.t String.Map.t 7 | ; exprvalue_ctx: ExprValue.t String.Map.t 8 | ; type_ctx: Infer.Type.t String.Map.t 9 | ; builtins: Expr.Op.t list } 10 | 11 | val empty : t 12 | 13 | val from_channel_exn : file:string -> In_channel.t -> t 14 | 15 | val from_channel : file:string -> In_channel.t -> t Or_error.t 16 | 17 | val from_file_exn : string -> t 18 | 19 | val from_file : string -> t Or_error.t 20 | 21 | val filter_keys : t -> f:(string -> bool) -> t 22 | -------------------------------------------------------------------------------- /lib/parser_ml.mly: -------------------------------------------------------------------------------- 1 | %{ 2 | open Ast 3 | open Collections 4 | %} 5 | 6 | %token ID 7 | %token NUM 8 | %token BOOL 9 | 10 | %token LET 11 | %token BUILTIN 12 | %token IN 13 | %token IF 14 | %token THEN 15 | %token ELSE 16 | %token FUN 17 | %token ADD 18 | %token SUB 19 | %token MUL 20 | %token DIV 21 | %token MOD 22 | %token EQ 23 | %token NEQ 24 | %token GT 25 | %token GE 26 | %token LT 27 | %token LE 28 | %token AMP 29 | %token AND 30 | %token BAR 31 | %token OR 32 | %token NOT 33 | %token CONS 34 | %token RCONS 35 | %token CAR 36 | %token CDR 37 | %token TREE 38 | %token CHILDREN 39 | %token VALUE 40 | %token SEMI 41 | %token ARROW 42 | %token LCBRACKET 43 | %token RCBRACKET 44 | %token LPAREN 45 | %token RPAREN 46 | %token LBRACKET 47 | %token RBRACKET 48 | %token COMMA 49 | 50 | %token EOF 51 | 52 | %right BAR OR 53 | %right AMP AND 54 | %left EQ NEQ GT LT LE GE 55 | %right CONS 56 | %left ADD SUB 57 | %left MUL DIV MOD 58 | %nonassoc NOT 59 | 60 | %start expr_ml_eof 61 | %start <[`Bind of (Ast.id * Ast.expr) | `Builtin of Ast.op list] list> toplevel_ml_eof 62 | %% 63 | 64 | expr_ml_eof: 65 | | x = expr_ml; EOF { x } 66 | 67 | toplevel_ml_eof: 68 | | x = toplevel_ml; EOF { x } 69 | 70 | toplevel_ml: 71 | | x = list(toplevel_decl_ml) { x } 72 | 73 | toplevel_decl_ml: 74 | | LET; x = ID; EQ; y = expr_ml { `Bind (x, y) } 75 | | LET; x = ID; xs = nonempty_list(ID); EQ; y = expr_ml; { `Bind (x, `Lambda (xs, y)) } 76 | | BUILTIN; xs = separated_list(COMMA, op) { `Builtin xs } 77 | 78 | expr_ml: 79 | | LET; x = ID; EQ; y = expr_ml; IN; z = expr_ml; { `Let (x, y, z) } 80 | | LET; x = ID; xs = nonempty_list(ID); EQ; y = expr_ml; IN; z = expr_ml; { `Let (x, `Lambda (xs, y), z) } 81 | | IF; x = expr_ml; THEN; y = expr_ml; ELSE; z = expr_ml { `Op (If, [x; y; z]) } 82 | | FUN; xs = nonempty_list(ID); ARROW; y = expr_ml { `Lambda(xs, y) } 83 | | x = simple_expr_ml { x } 84 | 85 | simple_expr_ml: 86 | | x = argument_ml { x } 87 | | x = argument_ml; ys = nonempty_list(argument_ml) { `Apply (x, ys) } 88 | | op = unop_call; x = argument_ml { `Op (op, [x]) } 89 | | op = binop_call; x = argument_ml; y = argument_ml { `Op (op, [x; y]) } 90 | | op = unop; x = simple_expr_ml; { `Op (op, [x]) } 91 | | x = simple_expr_ml; op = binop; y = simple_expr_ml; { `Op (op, [x; y]) } 92 | 93 | argument_ml: 94 | | x = BOOL { `Bool x } 95 | | x = NUM { `Num x } 96 | | x = ID { `Id x } 97 | | x = sexp(expr_ml) { x } 98 | | x = delimited(LBRACKET, separated_list(SEMI, expr_ml), RBRACKET) { `List x } 99 | | x = tree_ml { `Tree x } 100 | 101 | tree_ml: 102 | | LCBRACKET; RCBRACKET; { Tree.Empty } 103 | | LCBRACKET; x = expr_ml; SEMI; y = separated_list(SEMI, tree_ml); RCBRACKET; { Tree.Node (x, y) } 104 | 105 | %inline binop: 106 | | MUL { Mul } 107 | | DIV { Div } 108 | | MOD { Mod } 109 | | ADD { Plus } 110 | | SUB { Minus } 111 | | CONS { Cons } 112 | | EQ { Eq } 113 | | NEQ { Neq } 114 | | GT { Gt } 115 | | GE { Geq } 116 | | LT { Lt } 117 | | LE { Leq } 118 | | AMP { And } 119 | | BAR { Or } 120 | | AND { And } 121 | | OR { Or } 122 | 123 | %inline unop: 124 | | NOT { Not } 125 | 126 | %inline unop_call: 127 | | CAR { Car } 128 | | CDR { Cdr } 129 | | VALUE { Value } 130 | | CHILDREN { Children } 131 | 132 | %inline binop_call: 133 | | RCONS { RCons } 134 | | TREE { Tree } 135 | 136 | op: 137 | | x = binop { x } 138 | | x = unop { x } 139 | | x = unop_call { x } 140 | | x = binop_call { x } 141 | | IF { If } 142 | 143 | sexp(X): 144 | | LPAREN; x = X; RPAREN; { x } 145 | -------------------------------------------------------------------------------- /lib/parser_sexp.mly: -------------------------------------------------------------------------------- 1 | %{ 2 | open Ast 3 | open Collections 4 | %} 5 | 6 | %token ID 7 | %token NUM 8 | %token BOOL 9 | 10 | %token LET 11 | %token IF 12 | %token LAMBDA 13 | %token FORALL 14 | %token ADD 15 | %token SUB 16 | %token MUL 17 | %token DIV 18 | %token MOD 19 | %token EQ 20 | %token NEQ 21 | %token GT 22 | %token GE 23 | %token LT 24 | %token LE 25 | %token AMP 26 | %token AND 27 | %token BAR 28 | %token OR 29 | %token NOT 30 | %token CONS 31 | %token RCONS 32 | %token CAR 33 | %token CDR 34 | %token TREE 35 | %token CHILDREN 36 | %token VALUE 37 | %token ARROW 38 | %token LCBRACKET 39 | %token RCBRACKET 40 | %token LPAREN 41 | %token RPAREN 42 | %token LBRACKET 43 | %token RBRACKET 44 | %token COMMA 45 | %token EOF 46 | 47 | %start expr_eof 48 | %start example_eof 49 | %start constr_eof 50 | %start typ_eof 51 | %% 52 | 53 | expr_eof: 54 | | x = expr; EOF { x } 55 | 56 | example_eof: 57 | | x = example; EOF { x } 58 | 59 | constr_eof: 60 | | x = constr; EOF { x } 61 | 62 | typ_eof: 63 | | x = typ; EOF { x } 64 | 65 | %inline binop: 66 | | MUL { Mul } 67 | | DIV { Div } 68 | | MOD { Mod } 69 | | ADD { Plus } 70 | | SUB { Minus } 71 | | CONS { Cons } 72 | | EQ { Eq } 73 | | NEQ { Neq } 74 | | GT { Gt } 75 | | GE { Geq } 76 | | LT { Lt } 77 | | LE { Leq } 78 | | AMP { And } 79 | | BAR { Or } 80 | | AND { And } 81 | | OR { Or } 82 | 83 | %inline unop: 84 | | NOT { Not } 85 | 86 | %inline unop_call: 87 | | CAR { Car } 88 | | CDR { Cdr } 89 | | VALUE { Value } 90 | | CHILDREN { Children } 91 | 92 | %inline binop_call: 93 | | RCONS { RCons } 94 | | TREE { Tree } 95 | 96 | op: 97 | | x = binop { x } 98 | | x = unop { x } 99 | | x = unop_call { x } 100 | | x = binop_call { x } 101 | | IF { If } 102 | 103 | expr: 104 | | x = ID { `Id x } 105 | | x = sexp(let_body) { x } 106 | | x = sexp(lambda_body) { x } 107 | | x = sexp(call_body) { x } 108 | | x = BOOL { `Bool x } 109 | | x = NUM { `Num x } 110 | | x = tree; { `Tree x } 111 | | LBRACKET; x = list(expr); RBRACKET; { `List x } 112 | 113 | tree: 114 | | LCBRACKET; RCBRACKET; { Tree.Empty } 115 | | LCBRACKET; x = expr; y = list(tree); RCBRACKET; { Tree.Node (x, y) } 116 | 117 | let_body: 118 | | LET; i = ID; b = expr; e = expr; { `Let (i, b, e) } 119 | 120 | lambda_body: 121 | | LAMBDA; args = sexp(list(ID)); body = expr; { `Lambda (args, body) } 122 | 123 | call_body: 124 | | op = op; args = list(expr); { `Op (op, args) } 125 | | f = expr; args = list(expr); { `Apply (f, args) } 126 | 127 | constr: 128 | | LPAREN; FORALL; vars = sexp(list(ID)); body = expr; RPAREN { (body, vars) } 129 | 130 | example: 131 | | lhs = expr; ARROW; rhs = expr { (lhs, rhs) } 132 | 133 | typ: 134 | | x = simple_typ { x } 135 | | LPAREN; RPAREN; ARROW; output = typ; { Arrow_t ([], output) } 136 | | input = simple_typ; ARROW; output = typ; { Arrow_t ([input], output) } 137 | | inputs = sexp(typ_list); ARROW; output = typ; { Arrow_t (inputs, output) } 138 | 139 | simple_typ: 140 | | x = ID { match x with 141 | | "num" -> Const_t Num_t 142 | | "bool" -> Const_t Bool_t 143 | | _ -> Var_t (ref (Quant x)) } 144 | | x = sexp(typ); { x } 145 | | constr = ID; LBRACKET; arg = typ; RBRACKET { App_t (constr, [arg]) } 146 | | TREE; LBRACKET; arg = typ; RBRACKET { App_t ("tree", [arg]) } 147 | | constr = ID; LBRACKET; args = typ_list; RBRACKET { App_t (constr, args) } 148 | 149 | typ_list: 150 | | x = typ; COMMA; y = typ { [x; y] } 151 | | x = typ; COMMA; xs = typ_list { x::xs } 152 | 153 | sexp(X): 154 | | LPAREN; x = X; RPAREN; { x } 155 | -------------------------------------------------------------------------------- /lib/random_deduction.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | 3 | let drop_prob = 0.05 4 | 5 | let push_specs sk = if Random.float 1.0 <= drop_prob then None else Some sk 6 | -------------------------------------------------------------------------------- /lib/random_deduction.mli: -------------------------------------------------------------------------------- 1 | open Synthesis_common 2 | 3 | val push_specs : Deduction.t 4 | -------------------------------------------------------------------------------- /lib/recursive_spec_deduction.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | open Synthesis_common 3 | open Hypothesis 4 | open Collections 5 | module Sk = Skeleton 6 | module Sp = Specification 7 | 8 | exception Bottom 9 | 10 | let push_specs_exn : Sk.t -> unit = 11 | let rec push sps sk = 12 | let spec = Sk.spec sk in 13 | let sps = 14 | match Sp.data spec with 15 | | Sp.Top -> sps 16 | | Examples.Examples _ | FunctionExamples.FunctionExamples _ -> 17 | if Sp.Set.mem sps spec then raise Bottom ; 18 | Sp.Set.add sps spec 19 | | Sp.Bottom -> raise Bottom 20 | | _ -> sps 21 | in 22 | match Sk.ast sk with 23 | | Sk.Num _ | Sk.Bool _ | Sk.Id _ | Sk.Hole _ -> () 24 | | Sk.List l -> List.iter l ~f:(push sps) 25 | | Sk.Tree t -> Tree.iter t ~f:(push sps) 26 | | Sk.Let {bound; body} -> push sps bound ; push sps body 27 | | Sk.Lambda {body; _} -> push sps body 28 | | Sk.Op {args; _} | Sk.Apply {args; _} -> List.iter args ~f:(push sps) 29 | in 30 | push Sp.Set.empty 31 | 32 | let push_specs : Deduction.t = 33 | fun sk -> try push_specs_exn sk ; Some sk with Bottom -> None 34 | -------------------------------------------------------------------------------- /lib/sstream.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | include Stream 3 | 4 | type 'a matrix = 'a list t 5 | 6 | (* Concatenate two streams together. The second stream will not be 7 | inspected until the first stream is exhausted. *) 8 | let concat s1 s2 = 9 | from (fun _ -> 10 | match peek s1 with 11 | | Some _ -> Some (next s1) 12 | | None -> ( match peek s2 with Some _ -> Some (next s2) | None -> None ) ) 13 | 14 | (* Map a function over a stream. *) 15 | let map s ~f = from (fun _ -> try Some (f (next s)) with Failure -> None) 16 | 17 | (* Map a function over a matrix. *) 18 | let map_matrix s ~f = map s ~f:(List.map ~f) 19 | 20 | (* Create an infinite stream of 'value'. *) 21 | let repeat (value : 'a) : 'a t = from (fun _ -> Some value) 22 | 23 | (* Create a finite stream of 'value' of length 'n'. *) 24 | let repeat_n (n : int) (value : 'a) : 'a t = 25 | List.range 0 n |> List.map ~f:(fun _ -> value) |> of_list 26 | 27 | let trans : 'a t list -> 'a list t = function 28 | | [] -> repeat [] 29 | | ss -> from (fun _ -> Some (List.map ss ~f:next)) 30 | 31 | let diag (s : 'a t t) : 'a list t = 32 | from (fun i -> Some (List.map (npeek (i + 1) s) ~f:next)) 33 | 34 | let join (x : 'a matrix matrix) : 'a matrix = 35 | x |> map ~f:trans |> diag |> map ~f:(fun y -> y |> List.concat |> List.concat) 36 | 37 | let compose (f : 'a -> 'b matrix) (g : 'b -> 'c matrix) (x : 'a) : 'c matrix = 38 | x |> f |> map ~f:(List.map ~f:g) |> join 39 | 40 | let group s ~break = 41 | from (fun _ -> 42 | let rec collect () = 43 | match npeek 2 s with 44 | | [] -> None 45 | | [_] -> Some [next s] 46 | | [x; y] -> if break x y then Some [next s] else collect () 47 | | _ -> failwith "Stream.npeek returned a larger list than expected." 48 | in 49 | collect () ) 50 | 51 | let merge (ss : 'a matrix list) : 'a matrix = 52 | from (fun _ -> 53 | Some 54 | ( ss 55 | |> List.filter_map ~f:(fun s -> try Some (next s) with Failure -> None) 56 | |> List.concat ) ) 57 | 58 | let rec drop_while s ~f = 59 | match peek s with 60 | | Some x -> if f x then ( junk s ; drop_while s ~f ) else () 61 | | None -> () 62 | 63 | let flatten (m : 'a matrix) : 'a t = 64 | let current = ref [] in 65 | from (fun _ -> 66 | match !current with 67 | | x :: xs -> 68 | current := xs ; 69 | Some x 70 | | [] -> ( 71 | drop_while m ~f:(( = ) []) ; 72 | try 73 | match next m with 74 | | [] -> failwith "Failed to drop empty rows." 75 | | x :: xs -> 76 | current := xs ; 77 | Some x 78 | with Failure -> None ) ) 79 | 80 | module Memoizer 81 | (Key : Map.Key) (Value : sig 82 | type t 83 | end) = 84 | struct 85 | module KMap = Map.Make (Key) 86 | 87 | type memo_stream = 88 | {index: int ref; head: Value.t list Int.Table.t; stream: Value.t matrix} 89 | 90 | type t = memo_stream KMap.t ref 91 | 92 | let empty () = ref KMap.empty 93 | 94 | (* Get access to a stream of results for 'typ'. *) 95 | let get memo typ stream : Value.t matrix = 96 | let mstream = 97 | match KMap.find !memo typ with 98 | | Some s -> s 99 | | None -> 100 | let s = {index= ref 0; head= Int.Table.create (); stream= stream ()} in 101 | memo := KMap.set !memo ~key:typ ~data:s ; 102 | s 103 | in 104 | from (fun i -> 105 | let sc = i + 1 in 106 | if sc <= !(mstream.index) then Some (Int.Table.find_exn mstream.head sc) 107 | else ( 108 | List.range ~stop:`inclusive (!(mstream.index) + 1) sc 109 | |> List.iter ~f:(fun j -> 110 | try 111 | Int.Table.add_exn mstream.head ~key:j ~data:(next mstream.stream) ; 112 | incr mstream.index 113 | with Failure -> () ) ; 114 | if sc = !(mstream.index) then Some (Int.Table.find_exn mstream.head sc) 115 | else None ) ) 116 | end 117 | -------------------------------------------------------------------------------- /lib/status.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | open Collections 3 | 4 | type status = {synthesis: Counter.t; hashcons: Counter.t} 5 | 6 | let logo_lines = 7 | [ " .lkO0K0xc. " 8 | ; " 'kk;. .;kWXc " 9 | ; " .NN, kMMo" 10 | ; " 'WMWx kMMk" 11 | ; " ;dkc lWMX," 12 | ; " .:loc. .OMWx. " 13 | ; " .okcdWMN, .oXOc. " 14 | ; " .0o kMM0 .xNk' ';" 15 | ; " .' lMMN. .cOl. .KO" 16 | ; " ;MMM, lXWOddddddx0Md" 17 | ; " oMMM: ;kkkkkkkkkkkkk," 18 | ; " .ONWMMl " 19 | ; " 'XO.0MMo " 20 | ; " ,Ko OMMx " 21 | ; " .xNc xMMO " 22 | ; " ;NK, dMM0 " 23 | ; " .dNd. lMMX. .. " 24 | ; " ;XMo :MMM' ,O. " 25 | ; " dWNl .NMMOlxd. " 26 | ; "lKO: ;KMNx. " ] 27 | 28 | let status_lines = 29 | [ "" 30 | ; "SynthesizingDOTS" 31 | ; "" 32 | ; "Hypotheses verified: NUM_HYPOS" 33 | ; " Hypotheses saved: NUM_SAVED" 34 | ; "" 35 | ; "Memoization table hit rate: HIT_RATE" 36 | ; "" 37 | ; "Hashcons table equals calls: EQUALS_CALLS (EQUALS_TRUE t, EQUALS_FALSE f)" 38 | ; "Hashcons table hash calls: HASH_CALLS, hashcons calls: HASHCONS_CALLS" 39 | ; "Hashcons table len: TABLE_LEN, num entries: NUM_ENTRIES" 40 | ; "Hashcons bucket sum: BUCKET_SUM, min: BUCKET_MIN, med: BUCKET_MED, max: \ 41 | BUCKET_MAX" 42 | ; "" 43 | ; "Signatures: SIGS_NONE none, SIGS_CHECKED checked, SIGS_DUP dups, SIGS_FAIL \ 44 | fails" 45 | ; "" 46 | ; "" 47 | ; "" 48 | ; "" 49 | ; "" 50 | ; "" ] 51 | 52 | let escape esc = 53 | let suffix = function 54 | | `Save_cursor -> "7" 55 | | `Restore_cursor -> "8" 56 | | `Clear_cursor_down -> "[0J" 57 | | `Clear_entire_screen -> "[2J" 58 | | `Cursor_upper_left -> "[H" 59 | | `Reset -> "c" 60 | in 61 | let prefix = "\027" in 62 | prefix ^ suffix esc 63 | 64 | let enabled = ref true 65 | 66 | let enable : unit -> unit = fun () -> enabled := true 67 | 68 | let disable : unit -> unit = fun () -> enabled := false 69 | 70 | let print_status : status -> unit = 71 | let last_print = ref Time.epoch in 72 | let tick = ref 0 in 73 | fun status -> 74 | if !enabled then 75 | let diff = Time.diff (Time.now ()) !last_print in 76 | if Time.Span.( > ) diff (Time.Span.of_ms 500.0) then ( 77 | incr tick ; 78 | last_print := Time.now () ; 79 | let dots = [""; "."; ".."; "..."] in 80 | let hits = Counter.get status.synthesis "hole_hits" in 81 | let misses = Counter.get status.synthesis "hole_misses" in 82 | let rate = Float.of_int hits /. Float.of_int (hits + misses) *. 100.0 in 83 | let subs = 84 | [ ("NUM_HYPOS", Int.to_string (Counter.get status.synthesis "num_hypos")) 85 | ; ( "NUM_SAVED" 86 | , Int.to_string (Counter.get status.synthesis "num_saved_hypos") ) 87 | ; ("HIT_RATE", Float.to_string_hum ~decimals:2 rate) 88 | ; ("EQUALS_CALLS", Int.to_string (Counter.get status.hashcons "equal")) 89 | ; ("EQUALS_TRUE", Int.to_string (Counter.get status.hashcons "equal_true")) 90 | ; ( "EQUALS_FALSE" 91 | , Int.to_string (Counter.get status.hashcons "equal_false") ) 92 | ; ("HASH_CALLS", Int.to_string (Counter.get status.hashcons "hash")) 93 | ; ( "HASHCONS_CALLS" 94 | , Int.to_string (Counter.get status.hashcons "hashcons") ) 95 | ; ("TABLE_LEN", Int.to_string (Counter.get status.hashcons "table_len")) 96 | ; ( "NUM_ENTRIES" 97 | , Int.to_string (Counter.get status.hashcons "num_entries") ) 98 | ; ( "BUCKET_SUM" 99 | , Int.to_string (Counter.get status.hashcons "sum_bucket_len") ) 100 | ; ( "BUCKET_MIN" 101 | , Int.to_string (Counter.get status.hashcons "min_bucket_len") ) 102 | ; ( "BUCKET_MED" 103 | , Int.to_string (Counter.get status.hashcons "med_bucket_len") ) 104 | ; ( "BUCKET_MAX" 105 | , Int.to_string (Counter.get status.hashcons "max_bucket_len") ) 106 | ; ( "BUCKET_MAX" 107 | , Int.to_string (Counter.get status.hashcons "max_bucket_len") ) 108 | ; ( "SIGS_CHECKED" 109 | , Int.to_string (Counter.get status.synthesis "sigs_checked") ) 110 | ; ("SIGS_DUP", Int.to_string (Counter.get status.synthesis "sigs_dup")) 111 | ; ("SIGS_FAIL", Int.to_string (Counter.get status.synthesis "sigs_fail")) 112 | ; ("SIGS_NONE", Int.to_string (Counter.get status.synthesis "sigs_none")) 113 | ; ("DOTS", List.nth_exn dots (!tick % List.length dots)) ] 114 | in 115 | print_string (escape `Cursor_upper_left) ; 116 | print_string (escape `Reset) ; 117 | List.zip_exn logo_lines status_lines 118 | |> List.iter ~f:(fun (logo, status_line) -> 119 | let status_line = 120 | List.fold subs ~init:status_line ~f:(fun line (pattern, with_) -> 121 | String.substr_replace_first line ~pattern ~with_ ) 122 | in 123 | print_string logo ; 124 | print_string " " ; 125 | print_string status_line ; 126 | Out_channel.newline stdout ) ; 127 | Out_channel.flush stdout ) 128 | -------------------------------------------------------------------------------- /lib/status.mli: -------------------------------------------------------------------------------- 1 | open Collections 2 | 3 | type status = {synthesis: Counter.t; hashcons: Counter.t} 4 | 5 | val enable : unit -> unit 6 | 7 | val disable : unit -> unit 8 | 9 | val print_status : status -> unit 10 | -------------------------------------------------------------------------------- /lib/synthesis_common.mli: -------------------------------------------------------------------------------- 1 | open Core 2 | open Collections 3 | open Hypothesis 4 | open Infer 5 | 6 | module Generalizer : sig 7 | type t = 8 | Type.t StaticDistance.Map.t 9 | -> Type.t 10 | -> Symbol.t 11 | -> Specification.t 12 | -> (Hypothesis.t * Unifier.t) list 13 | 14 | type params = {cost_model: CostModel.t; library: Library.t} 15 | 16 | val generalize_single : params -> t -> Hypothesis.t -> Hypothesis.t list 17 | 18 | val generalize_all : params -> t -> Hypothesis.t -> Hypothesis.t list 19 | 20 | val compose : t -> t -> t 21 | 22 | val compose_all_exn : t list -> t 23 | end 24 | 25 | module Deduction : sig 26 | type t = Skeleton.t -> Skeleton.t Option.t 27 | 28 | val no_op : t 29 | 30 | val bottom : t 31 | 32 | val compose : t -> t -> t 33 | end 34 | 35 | val counter : Counter.t 36 | 37 | val timer : Timer.t 38 | 39 | val sexp_log : SexpLog.t 40 | 41 | module Memoizer : sig 42 | type t 43 | 44 | module Config : sig 45 | type t = 46 | { generalize: Generalizer.t 47 | ; cost_model: CostModel.t 48 | ; deduction: Deduction.t 49 | ; library: Library.t 50 | ; search_space_out: Out_channel.t Option.t } 51 | end 52 | 53 | val create : Config.t -> t 54 | 55 | val to_string : t -> string 56 | 57 | val fill_holes_in_hypothesis : 58 | t -> Hypothesis.t -> int -> (Hypothesis.t * Unifier.t) Sequence.t 59 | 60 | val get : 61 | t -> Hole.t -> Specification.t -> cost:int -> (Hypothesis.t * Unifier.t) list 62 | 63 | val to_sequence : 64 | t 65 | -> ?min_cost:int 66 | -> ?max_cost:int 67 | -> Hypothesis.t 68 | -> (Hypothesis.t * Unifier.t) Sequence.t Sequence.t 69 | 70 | val to_flat_sequence : 71 | t 72 | -> ?min_cost:int 73 | -> ?max_cost:int 74 | -> Hypothesis.t 75 | -> (Hypothesis.t * Unifier.t) Sequence.t 76 | end 77 | 78 | module Synthesizer : sig 79 | module type S = sig 80 | val synthesize : Hypothesis.t -> cost:int -> Hypothesis.t Option.t Or_error.t 81 | end 82 | end 83 | -------------------------------------------------------------------------------- /lib/testcase.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | open Collections 3 | 4 | exception JsonDecodeError of {msg: string; json: Json.json} 5 | 6 | type case = Examples of Example.t list * (string * Expr.t) list 7 | 8 | type t = {name: string; desc: string; case: case; blacklist: string list} 9 | 10 | let json_error str json = raise (JsonDecodeError {msg= str; json}) 11 | 12 | let get_key_exn : ?default:Json.json -> Json.json -> string -> Json.json = 13 | fun ?default json key -> 14 | match json with 15 | | `Assoc kv -> ( 16 | match (List.Assoc.find ~equal:String.equal kv key, default) with 17 | | Some v, _ | None, Some v -> v 18 | | None, None -> json_error (sprintf "Could not find key: %s" key) json ) 19 | | _ -> json_error "Expected an object." json 20 | 21 | let as_list_exn : Json.json -> Json.json list = function 22 | | `List l -> l 23 | | j -> json_error "Expected a list." j 24 | 25 | let as_string_exn : Json.json -> string = function 26 | | `String s -> s 27 | | j -> json_error "Expected a string." j 28 | 29 | let examples_of_json j = 30 | let exs_json = get_key_exn j "examples" in 31 | let bg_json = get_key_exn j "background" ~default:(`List []) in 32 | let exs = 33 | exs_json |> as_list_exn |> List.map ~f:as_string_exn 34 | |> List.map ~f:Example.of_string_exn 35 | in 36 | let bg = 37 | bg_json |> as_list_exn 38 | |> List.map ~f:(fun pair_json -> 39 | match as_list_exn pair_json with 40 | | [name_json; expr_json] -> 41 | ( as_string_exn name_json 42 | , as_string_exn expr_json |> Expr.of_string_exn ) 43 | | _ -> json_error "Expected name, expression pairs." pair_json ) 44 | in 45 | Examples (exs, bg) 46 | 47 | let of_json j = 48 | let open Json.Util in 49 | Or_error.try_with (fun () -> 50 | { name= j |> member "name" |> to_string 51 | ; desc= get_key_exn j "description" ~default:(`String "") |> as_string_exn 52 | ; blacklist= 53 | get_key_exn j "blacklist" ~default:(`List []) 54 | |> as_list_exn |> List.map ~f:as_string_exn 55 | ; case= 56 | ( match j |> member "kind" |> to_string with 57 | | "examples" -> j |> member "contents" |> examples_of_json 58 | | kind -> failwiths "Unexpected kind." kind [%sexp_of: string] ) } ) 59 | 60 | let from_file ~filename:fn = 61 | try Json.from_file ~fname:fn fn |> of_json with Yojson.Json_error err -> 62 | Or_error.error_string err 63 | 64 | let to_json t = 65 | let rest = 66 | match t.case with Examples (exs, bgs) -> 67 | [ ("kind", `String "examples") 68 | ; ( "contents" 69 | , `Assoc 70 | [ ( "examples" 71 | , `List (List.map exs ~f:(fun ex -> `String (Example.to_string ex))) 72 | ) 73 | ; ( "background" 74 | , `List 75 | (List.map bgs ~f:(fun (name, expr) -> 76 | `List [`String name; `String (Expr.to_string expr)] )) ) ] ) 77 | ] 78 | in 79 | `Assoc 80 | ( [ ("name", `String t.name) 81 | ; ("description", `String t.desc) 82 | ; ("blacklist", `List (List.map t.blacklist ~f:(fun x -> `String x))) ] 83 | @ rest ) 84 | 85 | let to_file ?format:(fmt = `Pretty) ~filename:fn t = 86 | let json = to_json t in 87 | Out_channel.with_file fn ~f:(fun ch -> 88 | try 89 | match fmt with 90 | | `Pretty -> Ok (Json.pretty_to_channel ~std:true ch json) 91 | | `Compact -> Ok (Json.to_channel ~std:true ch json) 92 | with Yojson.Json_error err -> Or_error.error_string err ) 93 | 94 | let to_file_exn ?format:(fmt = `Pretty) ~filename:fn t = 95 | to_file ~format:fmt ~filename:fn t |> Or_error.ok_exn 96 | 97 | let from_channel ch = 98 | try Json.from_channel ch |> of_json with Yojson.Json_error err -> 99 | Or_error.error_string err 100 | -------------------------------------------------------------------------------- /lib/testcase.mli: -------------------------------------------------------------------------------- 1 | open Core 2 | open Collections 3 | 4 | type case = 5 | | Examples of Example.t list * ((string * Expr.t) list) 6 | 7 | type t = { 8 | name : string; 9 | desc : string; 10 | case : case; 11 | 12 | (** Functions to ignore when synthesizing the test case. This is 13 | useful to disallow implementations which simply call the correct 14 | function. 15 | 16 | This is simpler than providing a separate function library 17 | per-testcase. *) 18 | blacklist : string list; 19 | } 20 | 21 | val of_json : Json.json -> t Or_error.t 22 | val to_json : t -> Json.json 23 | 24 | val from_file : filename:string -> t Or_error.t 25 | 26 | val to_file : ?format:[ `Pretty | `Compact ] -> filename:string -> t -> unit Or_error.t 27 | val to_file_exn : ?format:[ `Pretty | `Compact ] -> filename:string -> t -> unit 28 | 29 | val from_channel : In_channel.t -> t Or_error.t 30 | -------------------------------------------------------------------------------- /lib/unify.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | open Ast 3 | 4 | type id = string 5 | 6 | exception Non_unifiable 7 | 8 | exception Translation_error 9 | 10 | exception Unknown 11 | 12 | type term = Var of id | Term of id * term list [@@deriving sexp] 13 | 14 | type sterm = 15 | | Cons of sterm * sterm 16 | | K of id 17 | (* Konstant *) 18 | | V of id 19 | (* Variable *) 20 | | U of id * bool 21 | 22 | (* Volatile? variable *) 23 | 24 | type substitution = (id * term) list [@@deriving sexp] 25 | 26 | let rec sterm_to_string (s : sterm) : string = 27 | let ts = sterm_to_string in 28 | match s with 29 | | Cons (x, xs) -> sprintf "Cons(%s, %s)" (ts x) (ts xs) 30 | | K x -> x 31 | | V x -> x 32 | | U (x, _) -> x 33 | 34 | (* Convert an expression to a unifiable term. *) 35 | let sterm_of_expr_value : ExprValue.t -> sterm option = 36 | fun e -> 37 | let rec f e = 38 | match e with 39 | | `Unit -> K "unit" 40 | | `Num x -> K (Int.to_string x) 41 | | `Bool x -> K (if x then "true" else "false") 42 | | `List [] -> K "[]" 43 | | `List (x :: xs) -> Cons (f x, f (`List xs)) 44 | | `Id x -> V x 45 | | `Op (RCons, [xs; x]) | `Op (Ast.Cons, [x; xs]) -> Cons (f x, f xs) 46 | | `Apply _ -> V (ExprValue.to_string e) 47 | | `Closure _ | `Let _ | `Tree _ | `Lambda _ | `Op _ -> raise Unknown 48 | in 49 | try Some (f e) with Unknown -> None 50 | 51 | let sterm_of_expr (e : Expr.t) : sterm option = 52 | let rec f e = 53 | match e with 54 | | `Num x -> K (Int.to_string x) 55 | | `Bool x -> K (if x then "true" else "false") 56 | | `List [] -> K "[]" 57 | | `List (x :: xs) -> Cons (f x, f (`List xs)) 58 | | `Id x -> V x 59 | | `Op (RCons, [xs; x]) | `Op (Ast.Cons, [x; xs]) -> Cons (f x, f xs) 60 | | `Let _ | `Tree _ | `Apply _ | `Lambda _ | `Op _ -> raise Unknown 61 | in 62 | try Some (f e) with Unknown -> None 63 | 64 | let sterm_of_value v = 65 | let rec f v = 66 | match v with 67 | | `Num x -> K (Int.to_string x) 68 | | `Bool x -> K (if x then "true" else "false") 69 | | `List [] -> K "[]" 70 | | `List (x :: xs) -> Cons (f x, f (`List xs)) 71 | | `Unit | `Closure _ | `Tree _ -> raise Unknown 72 | in 73 | try Some (f v) with Unknown -> None 74 | 75 | (* let sterm_of_result r = *) 76 | (* let fresh_name = Util.Fresh.mk_fresh_name_fun () in *) 77 | (* let open Symbolic_execution in *) 78 | (* let rec f r = match r with *) 79 | (* | Num_r x -> K (Int.to_string x) *) 80 | (* | Bool_r x -> K (if x then "true" else "false") *) 81 | (* | List_r [] -> K "[]" *) 82 | (* | List_r (x::xs) -> Cons (f x, f (List_r xs)) *) 83 | (* | Id_r (Skeleton.Id.StaticDistance sd) -> V (StaticDistance.to_string sd) *) 84 | (* | Id_r (Skeleton.Id.Name id) -> V id *) 85 | (* | Op_r (RCons, [xs; x]) *) 86 | (* | Op_r (Cons, [x; xs]) -> Cons (f x, f xs) *) 87 | (* | Symbol_r id -> V (Int.to_string id) *) 88 | (* | Apply_r _ -> V (fresh_name ()) *) 89 | (* | Closure_r _ *) 90 | (* | Tree_r _ *) 91 | (* | Op_r _ -> raise Unknown *) 92 | (* in try Some (f r) with Unknown -> None *) 93 | 94 | (* the occurs check *) 95 | let rec occurs (x : id) (t : term) : bool = 96 | match t with Var y -> x = y | Term (_, s) -> List.exists ~f:(occurs x) s 97 | 98 | (* substitute term s for all occurrences of variable x in term t *) 99 | let rec subst (s : term) (x : id) (t : term) : term = 100 | match t with 101 | | Var y -> if x = y then s else t 102 | | Term (f, u) -> Term (f, List.map ~f:(subst s x) u) 103 | 104 | (* apply a substitution right to left *) 105 | let apply (s : substitution) (t : term) : term = 106 | List.fold_right ~f:(fun (x, u) -> subst u x) s ~init:t 107 | 108 | (* unify one pair *) 109 | let rec unify_one (s : term) (t : term) : substitution = 110 | match (s, t) with 111 | | Var x, Var y -> if x = y then [] else [(x, t)] 112 | | Term (f, sc), Term (g, tc) -> 113 | if f = g && List.length sc = List.length tc then unify (List.zip_exn sc tc) 114 | else raise Non_unifiable 115 | | Var x, (Term (_, _) as t) | (Term (_, _) as t), Var x -> 116 | if occurs x t then raise Non_unifiable else [(x, t)] 117 | 118 | (* unify a list of pairs *) 119 | and unify (s : (term * term) list) : substitution = 120 | match s with 121 | | [] -> [] 122 | | (x, y) :: t -> 123 | let t2 = unify t in 124 | let t1 = unify_one (apply t2 x) (apply t2 y) in 125 | t1 @ t2 126 | 127 | let fvar = ref 0 128 | 129 | let fresh () : string = 130 | fvar := !fvar + 1 ; 131 | "V" ^ string_of_int !fvar 132 | 133 | (* Support code *) 134 | let rec translate (s : sterm) : term = 135 | match s with 136 | | Cons (x, y) -> 137 | let t1 = translate x and t2 = translate y in 138 | Term ("Cons", [t1] @ [t2]) 139 | | K c -> Term (c, []) 140 | | V c | U (c, _) -> Var c 141 | 142 | let rec retranslate (t : term) : sterm = 143 | match t with 144 | | Var v -> V v 145 | | Term (k, []) -> K k 146 | | Term ("Cons", h :: t) -> ( 147 | match t with 148 | | [tt] -> Cons (retranslate h, retranslate tt) 149 | | _ -> raise Translation_error ) 150 | | _ -> raise Translation_error 151 | 152 | let rec to_string (s : sterm) : string = 153 | match s with 154 | | Cons (h, t) -> "Cons(" ^ to_string h ^ "," ^ to_string t ^ ")" 155 | | K t | V t -> t 156 | | U (t, vol) -> if vol then raise Unknown (* sanity check *) else t 157 | 158 | let sub_to_string (s : substitution) : string = 159 | List.map ~f:(fun (i, t) -> i ^ " = " ^ to_string (retranslate t)) s 160 | |> String.concat ~sep:"," 161 | 162 | and print_sub (s : substitution) = 163 | let ss = List.map ~f:(fun (i, t) -> i ^ " = " ^ to_string (retranslate t)) s in 164 | List.iter ~f:(fun t -> Printf.printf "%s\n" t) ss 165 | 166 | (* End Support code *) 167 | 168 | (* "concretize" one volatile term with the one from hypothesis *) 169 | let rec make_one_concrete (s1 : sterm) (s3 : sterm) (made : bool) = 170 | if made then (made, s3) 171 | else 172 | match (s1, s3) with 173 | | Cons (h1, t1), Cons (h2, t2) -> 174 | let md1, sh = make_one_concrete h1 h2 made in 175 | let md2, st = make_one_concrete t1 t2 md1 in 176 | (md2, Cons (sh, st)) 177 | | K _, K _ | V _, V _ | _, U (_, false) -> (false, s3) 178 | | K _, U (_, true) | V _, U (_, true) -> (true, s1) 179 | | Cons (_, _), U (_, true) -> 180 | (true, Cons (U (fresh (), true), U (fresh (), true))) 181 | | _, _ -> raise Unknown 182 | 183 | (* the non-volatile term is now part of the core *) 184 | let make_one_non_volatile (s3 : sterm) = 185 | let rec aux (ss : sterm) (made : bool) = 186 | if made then (made, ss) 187 | else 188 | match ss with 189 | | Cons (h, t) -> 190 | let md1, sh = aux h made in 191 | let md2, st = aux t md1 in 192 | (md2, Cons (sh, st)) 193 | | K _ | V _ | U (_, false) -> (false, ss) 194 | | U (u, true) -> (true, U ("C" ^ u, false)) 195 | in 196 | let _, ss3 = aux s3 false in 197 | ss3 198 | 199 | (* concretize <-> unify loop until we cannot concretize anymore *) 200 | let rec unifiable_core_aux (s1 : sterm) (s3 : sterm) (s2 : sterm) = 201 | try 202 | let made, s3' = make_one_concrete s1 s3 false in 203 | let sub = unify [(translate s3', translate s2)] in 204 | if not made then (s3', sub) else unifiable_core_aux s1 s3' s2 205 | with Non_unifiable -> unifiable_core_aux s1 (make_one_non_volatile s3) s2 206 | 207 | (* Main *) 208 | let unifiable_core (s1 : sterm) (s2 : sterm) = 209 | try 210 | let sub = unify [(translate s1, translate s2)] in 211 | (s1, sub) 212 | with Non_unifiable -> unifiable_core_aux s1 (U (fresh (), true)) s2 213 | -------------------------------------------------------------------------------- /lib/util.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | 3 | (** Module for creating fresh names and numbers. *) 4 | module Fresh = struct 5 | let count = ref (-1) 6 | 7 | let int () = incr count ; !count 8 | 9 | let name prefix = Printf.sprintf "%s%d" prefix (int ()) 10 | 11 | let names prefix num = List.range 0 num |> List.map ~f:(fun _ -> name prefix) 12 | 13 | (** Create a function for returning fresh integers. *) 14 | let mk_fresh_int_fun () = 15 | let count = ref (-1) in 16 | fun () -> 17 | incr count ; 18 | let n = !count in 19 | if n < 0 then failwith "Out of fresh integers." else n 20 | 21 | (** Create a function for returning fresh names. These names will be 22 | of the form [a-z][0-9]*. *) 23 | let mk_fresh_name_fun () = 24 | let fresh_int = mk_fresh_int_fun () in 25 | fun () -> 26 | let n = fresh_int () in 27 | let prefix = Char.of_int_exn ((n mod 26) + 97) in 28 | let suffix = if n >= 26 then Int.to_string ((n - 26) mod 26) else "" in 29 | Printf.sprintf "%c%s" prefix suffix 30 | end 31 | 32 | module IntListSet = Set.Make (struct 33 | type t = int list 34 | 35 | let compare = List.compare Int.compare 36 | 37 | let sexp_of_t = List.sexp_of_t Int.sexp_of_t 38 | 39 | let t_of_sexp = List.t_of_sexp Int.t_of_sexp 40 | end) 41 | 42 | let partition n : int list list = 43 | let map_range a b f = List.map (List.range a b) ~f in 44 | let add_to_partition x p = List.sort ~compare:Int.compare (p @ [x]) in 45 | let rec part n : IntListSet.t = 46 | match n with 47 | | 0 -> IntListSet.empty 48 | (* n is always a partition of itself. For each number x in [0, n) 49 | generate each partition of n - x and add x to each partition. *) 50 | | n -> 51 | IntListSet.union_list 52 | ( [IntListSet.singleton [n]] 53 | @ map_range 1 n (fun x -> 54 | IntListSet.map (part (n - x)) ~f:(add_to_partition x) ) ) 55 | in 56 | IntListSet.to_list (part n) 57 | 58 | let m_partition n m = List.filter (partition n) ~f:(fun p -> m = List.length p) 59 | 60 | (* insert x at all positions into l and return the list of results *) 61 | let rec insert x l = 62 | match l with 63 | | [] -> [[x]] 64 | | a :: m -> (x :: l) :: List.map (insert x m) ~f:(fun y -> a :: y) 65 | 66 | (* list of all permutations of l *) 67 | let rec permutations = function 68 | | [] -> [] 69 | | [x] -> [[x]] 70 | | x :: xs -> List.concat_map (permutations xs) ~f:(insert x) 71 | 72 | let combinations l k = 73 | let rec aux k acc emit = function 74 | | [] -> acc 75 | | h :: t -> 76 | if k = 1 then aux k (emit [h] acc) emit t 77 | else 78 | let new_emit x = emit (h :: x) in 79 | aux k (aux (k - 1) acc new_emit t) emit t 80 | in 81 | let emit x acc = x :: acc in 82 | aux k [] emit l 83 | 84 | let permutations_k l k = List.concat_map ~f:permutations (combinations l k) 85 | 86 | let uniq (l : 'a list) : 'a list = 87 | List.fold_left l 88 | ~f:(fun (acc : 'a list) (e : 'a) -> 89 | if List.mem ~equal:( = ) acc e then acc else e :: acc ) 90 | ~init:[] 91 | 92 | let rec all_equal (l : 'a list) ~eq = 93 | match l with 94 | | x :: xs -> List.for_all xs ~f:(eq x) && all_equal ~eq xs 95 | | [] -> true 96 | 97 | let rec unzip3 l = 98 | match l with 99 | | (a1, b1, c1) :: xs -> 100 | let a, b, c = unzip3 xs in 101 | (a1 :: a, b1 :: b, c1 :: c) 102 | | [] -> ([], [], []) 103 | 104 | let rec zip3_exn (l1 : 'a list) (l2 : 'b list) (l3 : 'c list) : ('a * 'b * 'c) list 105 | = 106 | match (l1, l2, l3) with 107 | | x :: xs, y :: ys, z :: zs -> (x, y, z) :: zip3_exn xs ys zs 108 | | [], [], [] -> [] 109 | | _ -> failwith "Lists have different lengths." 110 | 111 | let superset l1 l2 = 112 | List.length l1 >= List.length l2 && List.for_all l2 ~f:(List.mem ~equal:( = ) l1) 113 | 114 | let strict_superset l1 l2 = 115 | List.length l1 > List.length l2 && List.for_all l2 ~f:(List.mem ~equal:( = ) l1) 116 | 117 | let lsplit2_on_str s ~on = 118 | match String.substr_index s ~pattern:on with 119 | | Some split_index -> 120 | Some 121 | ( String.slice s 0 split_index 122 | , String.slice s (split_index + String.length on) (String.length s) ) 123 | | None -> None 124 | 125 | let max = List.fold_left ~f:(fun a e -> if e > a then e else a) ~init:Int.min_value 126 | 127 | let log verbosity level str = 128 | if verbosity >= level then ( print_endline str ; Out_channel.flush stdout ) 129 | else () 130 | 131 | let with_runtime (thunk : unit -> 'a) : 'a * Time.Span.t = 132 | let start_t = Time.now () in 133 | let x = thunk () in 134 | let end_t = Time.now () in 135 | (x, Time.diff end_t start_t) 136 | 137 | let add_time (t1 : Time.Span.t ref) (t2 : Time.Span.t) : unit = 138 | t1 := Time.Span.( + ) !t1 t2 139 | 140 | let print_sexp x s = print_endline (Sexp.to_string_hum (s x)) 141 | -------------------------------------------------------------------------------- /lib/v1_engine.mli: -------------------------------------------------------------------------------- 1 | open Core 2 | open Collections 3 | open Infer 4 | 5 | type config = 6 | { verbosity: int 7 | ; untyped: bool 8 | ; deduction: bool 9 | ; infer_base: bool 10 | ; max_exhaustive_depth: int 11 | ; flat_cost: bool } 12 | 13 | val default_init : TypedExpr.t List.t 14 | 15 | (* val extended_init : TypedExpr.t List.t *) 16 | (* val default_operators : Expr.Op.t List.t *) 17 | 18 | (* val timer : Timer.t *) 19 | (* val counter : Counter.t *) 20 | 21 | val solve : 22 | ?config:config 23 | -> ?bk:(String.t * Expr.t) List.t 24 | -> ?init:TypedExpr.t List.t 25 | -> Example.t List.t 26 | -> Expr.t Ctx.t 27 | -------------------------------------------------------------------------------- /lib/v1_solver_engine.mli: -------------------------------------------------------------------------------- 1 | open Core 2 | open Collections 3 | open Infer 4 | 5 | val default_init : TypedExpr.t List.t 6 | 7 | val extended_init : TypedExpr.t List.t 8 | 9 | val default_operators : Expr.Op.t List.t 10 | 11 | val timer : Timer.t 12 | 13 | val counter : Counter.t 14 | 15 | val solve : 16 | ?config:Config.t 17 | -> ?bk:(String.t * Expr.t) List.t 18 | -> ?init:TypedExpr.t List.t 19 | -> Example.t List.t 20 | -> Expr.t Ctx.t 21 | -------------------------------------------------------------------------------- /lib/v2_engine.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | open Synthesis_common 3 | open Ast 4 | open Collections 5 | open Hypothesis 6 | open Infer 7 | 8 | let default_cost_model : CostModel.t = 9 | let module Sk = Skeleton in 10 | let module C = CostModel in 11 | { C.num= (fun _ -> 1) 12 | ; C.bool= (fun _ -> 1) 13 | ; C.hole= (fun _ -> 0) 14 | ; C.lambda= (fun _ _ -> 1) 15 | ; C._let= (fun _ _ -> 1) 16 | ; C.list= (fun _ -> 1) 17 | ; C.tree= (fun _ -> 1) 18 | ; C.apply= (fun _ _ -> 0) 19 | ; C.op= (fun op _ -> Expr.Op.cost op) 20 | ; C.id= 21 | (function 22 | | Sk.Id.Name name -> ( 23 | match name with 24 | | "foldr" | "foldl" | "foldt" | "zipWith" -> 3 25 | | "map" | "mapt" | "filter" -> 2 26 | | _ -> 1 ) 27 | | Sk.Id.StaticDistance _ -> 1) } 28 | 29 | module L2_Generalizer = struct 30 | (* This generalizer generates programs of the following form. Each 31 | hole in the hypotheses that it returns is tagged with a symbol 32 | name that the generalizer uses to select the hypotheses that can 33 | be used to fill that hole later. 34 | 35 | L := fun x_1 ... x_n -> E 36 | 37 | E := map I (L) 38 | | filter I (L) 39 | | foldl I (L) C 40 | | ... 41 | | E' 42 | 43 | E' := car E' 44 | | cdr E' 45 | | cons E' E' 46 | | ... 47 | | C 48 | 49 | C := 0 50 | | 1 51 | | [] 52 | | ... 53 | 54 | I := 55 | *) 56 | 57 | module type S = sig 58 | val create : CostModel.t -> Library.t -> Generalizer.t 59 | end 60 | 61 | module Symbols = struct 62 | let lambda = Symbol.create "Lambda" 63 | 64 | let combinator = Symbol.create "Combinator" 65 | 66 | let expression = Symbol.create "Expression" 67 | 68 | let constant = Symbol.create "Constant" 69 | 70 | let identifier = Symbol.create "Identifier" 71 | 72 | let base_case = Symbol.create "BaseCase" 73 | end 74 | 75 | open Symbols 76 | module G = Generalizer 77 | module Sp = Specification 78 | module H = Hypothesis 79 | 80 | let generate_constants params _ type_ _ spec = 81 | match type_ with 82 | | Arrow_t _ -> [] 83 | | _ -> 84 | let cost_model = params.G.cost_model in 85 | let constants = 86 | [ ( Type.num 87 | , [ H.num cost_model 0 spec 88 | ; H.num cost_model 1 spec 89 | ; H.num cost_model Int.max_value spec ] ) 90 | ; (Type.bool, [H.bool cost_model true spec; H.bool cost_model false spec]) 91 | ; ( Type.list (Type.quant "a") |> instantiate 0 92 | , [H.list cost_model [] spec] ) ] 93 | in 94 | List.concat_map constants ~f:(fun (t, xs) -> 95 | match Infer.Unifier.of_types type_ t with 96 | | Some u -> List.map xs ~f:(fun x -> (x, u)) 97 | | None -> [] ) 98 | 99 | let generate_identifiers params ctx type_ _ spec = 100 | match type_ with 101 | | Arrow_t _ -> [] 102 | | _ -> 103 | List.filter_map (StaticDistance.Map.to_alist ctx) ~f:(fun (id, id_t) -> 104 | Option.map (Unifier.of_types type_ id_t) ~f:(fun u -> 105 | (H.id_sd params.G.cost_model id spec, u) ) ) 106 | 107 | let generate_expressions params ctx type_ _ spec = 108 | match type_ with 109 | | Arrow_t _ -> [] 110 | | _ -> 111 | let cost_model = params.G.cost_model in 112 | let op_exprs = 113 | List.filter_map params.G.library.Library.builtins ~f:(fun op -> 114 | let op_t = instantiate 0 (Expr.Op.meta op).Expr.Op.typ in 115 | match op_t with 116 | | Arrow_t (args_t, ret_t) -> 117 | (* Try to unify the return type of the operator with the type of the hole. *) 118 | Option.map (Unifier.of_types type_ ret_t) ~f:(fun u -> 119 | (* If unification succeeds, apply the unifier to the rest of the type. *) 120 | let args_t = List.map args_t ~f:(Unifier.apply u) in 121 | let arg_holes = 122 | List.map args_t ~f:(fun t -> 123 | H.hole cost_model (Hole.create ~ctx t expression) Sp.top 124 | ) 125 | in 126 | (H.op cost_model op arg_holes spec, u) ) 127 | | _ -> None ) 128 | in 129 | let functions = params.G.library.Library.type_ctx |> String.Map.to_alist in 130 | let apply_exprs = 131 | List.filter_map functions ~f:(fun (func, func_t) -> 132 | let func_t = instantiate 0 func_t in 133 | match func_t with 134 | | Arrow_t (args_t, ret_t) -> 135 | (* Try to unify the return type of the operator with the type of the hole. *) 136 | Option.map (Unifier.of_types type_ ret_t) ~f:(fun u -> 137 | (* If unification succeeds, apply the unifier to the rest of the type. *) 138 | let args_t = List.map args_t ~f:(Unifier.apply u) in 139 | let arg_holes = 140 | List.map args_t ~f:(fun t -> 141 | H.hole cost_model (Hole.create ~ctx t expression) Sp.top 142 | ) 143 | in 144 | ( H.apply cost_model 145 | (H.id_name cost_model func Sp.top) 146 | arg_holes spec 147 | , u ) ) 148 | | _ -> None ) 149 | in 150 | op_exprs @ apply_exprs 151 | 152 | let generate_lambdas params ctx type_ _ spec = 153 | let cost_model = params.G.cost_model in 154 | match type_ with 155 | (* If the hole has an arrow type, generate a lambda expression with 156 | the right number of arguments and push the specification down. *) 157 | | Arrow_t (args_t, ret_t) -> 158 | let num_args = List.length args_t in 159 | let arg_names = StaticDistance.args num_args in 160 | let type_ctx = 161 | List.fold (List.zip_exn arg_names args_t) 162 | ~init:(StaticDistance.map_increment_scope ctx) 163 | ~f:(fun ctx (arg, arg_t) -> 164 | StaticDistance.Map.set ctx ~key:arg ~data:arg_t ) 165 | in 166 | let lambda = 167 | H.lambda cost_model num_args 168 | (H.hole cost_model (Hole.create ~ctx:type_ctx ret_t combinator) Sp.top) 169 | spec 170 | in 171 | [(lambda, Unifier.empty)] 172 | | _ -> [] 173 | 174 | let create select cost_model library = 175 | let params = {G.cost_model; G.library} in 176 | let generalize ctx type_ symbol spec = 177 | let generators = select symbol in 178 | List.concat (List.map generators ~f:(fun g -> g params ctx type_ symbol spec)) 179 | in 180 | generalize 181 | 182 | module With_components = struct 183 | let select _ = 184 | [ generate_constants 185 | ; generate_identifiers 186 | ; generate_expressions 187 | ; generate_lambdas ] 188 | 189 | let create = create select 190 | end 191 | 192 | module No_components = struct 193 | let select _ = 194 | [ generate_constants 195 | ; generate_identifiers 196 | ; generate_expressions 197 | ; generate_lambdas ] 198 | 199 | let create = create select 200 | end 201 | 202 | module No_lambdas = struct 203 | let select _ = 204 | [ generate_constants 205 | ; generate_identifiers 206 | ; generate_expressions 207 | ; generate_lambdas ] 208 | 209 | let create = create select 210 | end 211 | end 212 | 213 | module L2_Synthesizer = struct 214 | type t = 215 | { cost_model: CostModel.t 216 | ; gen_no_lambdas: Generalizer.t 217 | ; gen_no_components: Generalizer.t 218 | ; deduce: Deduction.t 219 | ; memoizer: Memoizer.t 220 | ; library: Library.t } 221 | 222 | let create ?(cost_model = default_cost_model) deduce library = 223 | let gen_no_lambdas = L2_Generalizer.No_lambdas.create cost_model library in 224 | let gen_no_components = 225 | L2_Generalizer.No_components.create cost_model library 226 | in 227 | { gen_no_lambdas 228 | ; gen_no_components 229 | ; deduce 230 | ; cost_model 231 | ; library 232 | ; memoizer= 233 | (let open Memoizer.Config in 234 | Memoizer.create 235 | { library 236 | ; cost_model 237 | ; deduction= deduce 238 | ; generalize= gen_no_lambdas 239 | ; search_space_out= None }) } 240 | 241 | let synthesize ?(max_cost = Int.max_value) s hypo = 242 | let module H = Hypothesis in 243 | let rec search (cost : int) = 244 | (* If the cost of searching this level exceeds the max cost, end the search. *) 245 | if cost > max_cost then Ok None 246 | else 247 | let candidates = 248 | Memoizer.fill_holes_in_hypothesis s.memoizer hypo (cost + H.cost hypo) 249 | in 250 | match Sequence.hd candidates with 251 | | Some (sln, _) -> Ok (Some sln) 252 | | None -> search (cost + 1) 253 | in 254 | search 0 255 | 256 | let initial_hypothesis s examples = 257 | let spec = 258 | List.map examples ~f:(function 259 | | `Apply (_, args), out -> 260 | let ctx = StaticDistance.Map.empty in 261 | let args = List.map ~f:(Eval.eval (Ctx.empty ())) args in 262 | let ret = Eval.eval (Ctx.empty ()) out in 263 | ((ctx, args), ret) 264 | | ex -> failwiths "Unexpected example type." ex sexp_of_example ) 265 | |> FunctionExamples.of_list_exn |> FunctionExamples.to_spec 266 | in 267 | let t = Infer.Type.normalize (Example.signature examples) in 268 | Hypothesis.hole s.cost_model (Hole.create t L2_Generalizer.Symbols.lambda) spec 269 | end 270 | -------------------------------------------------------------------------------- /lib/v2_engine.mli: -------------------------------------------------------------------------------- 1 | open Core 2 | open Synthesis_common 3 | open Hypothesis 4 | 5 | val default_cost_model : CostModel.t 6 | 7 | module L2_Generalizer : sig 8 | module type S = sig 9 | val create : CostModel.t -> Library.t -> Generalizer.t 10 | end 11 | 12 | module Symbols : sig 13 | val lambda : Symbol.t 14 | 15 | val combinator : Symbol.t 16 | 17 | val expression : Symbol.t 18 | 19 | val constant : Symbol.t 20 | 21 | val identifier : Symbol.t 22 | 23 | val base_case : Symbol.t 24 | end 25 | 26 | module With_components : S 27 | 28 | module No_components : S 29 | 30 | module No_lambdas : S 31 | end 32 | 33 | module L2_Synthesizer : sig 34 | type t 35 | 36 | val create : ?cost_model:CostModel.t -> Deduction.t -> Library.t -> t 37 | 38 | val synthesize : 39 | ?max_cost:int -> t -> Hypothesis.t -> Hypothesis.t Option.t Or_error.t 40 | 41 | val initial_hypothesis : t -> Example.t list -> Hypothesis.t 42 | end 43 | -------------------------------------------------------------------------------- /lib/value.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | open Collections 3 | 4 | module T = struct 5 | type t = Ast.value [@@deriving compare] 6 | 7 | let rec sexp_of_t : t -> Sexp.t = 8 | let list x = Sexp.List x in 9 | let atom x = Sexp.Atom x in 10 | function 11 | | `Num x -> list [atom "Num"; [%sexp_of: int] x] 12 | | `Bool x -> list [atom "Bool"; [%sexp_of: bool] x] 13 | | `List x -> list [atom "List"; [%sexp_of: t list] x] 14 | | `Tree x -> list [atom "Tree"; [%sexp_of: t Tree.t] x] 15 | | `Closure (expr, ctx) -> 16 | let ctx_sexp = [%sexp_of: string list] (Ctx.keys ctx) in 17 | list [atom "Closure"; [%sexp_of: Expr.t] expr; ctx_sexp] 18 | | `Unit -> atom "Unit" 19 | 20 | let t_of_sexp : Sexp.t -> t = 21 | fun _ -> Or_error.unimplemented "Value.t_of_sexp" |> Or_error.ok_exn 22 | end 23 | 24 | include T 25 | 26 | let rec to_string : t -> string = function 27 | | `Num x -> sprintf "%d" x 28 | | `Bool true -> "true" 29 | | `Bool false -> "false" 30 | | `Tree x -> Tree.to_string x ~str:to_string 31 | | `List x -> "[" ^ (List.map x ~f:to_string |> String.concat ~sep:"; ") ^ "]" 32 | | `Closure _ -> "" 33 | | `Unit -> "()" 34 | 35 | include Comparable.Make (T) 36 | -------------------------------------------------------------------------------- /lib/value.mli: -------------------------------------------------------------------------------- 1 | open Core 2 | 3 | type t = Ast.value 4 | 5 | val to_string : t -> string 6 | 7 | include Comparable.S with type t := t 8 | 9 | include Sexpable.S with type t := t 10 | -------------------------------------------------------------------------------- /lib/verify.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | open Ast 3 | open Collections 4 | 5 | type status = Invalid | Valid | Error 6 | 7 | (* type typed_constr = typed_expr * typed_id list *) 8 | 9 | (* let typed_constr constr = *) 10 | (* let body, vars = constr in *) 11 | (* let body' = *) 12 | (* let typ_ctx = List.map vars ~f:(fun var -> (var, fresh_free 0)) |> Ctx.of_alist_exn in *) 13 | (* Infer.infer typ_ctx body in *) 14 | (* let ctx = Ctx.empty () in *) 15 | (* let rec find_vars texpr = match texpr with *) 16 | (* | Num _ | Bool _ -> () *) 17 | (* | List (x, _) -> List.iter x ~f:find_vars *) 18 | (* | Lambda ((_, x), _) -> find_vars x *) 19 | (* | Apply ((x, y), _) -> find_vars x; List.iter y ~f:find_vars *) 20 | (* | Op ((_, x), _) -> List.iter x ~f:find_vars *) 21 | (* | Let ((_, x, y), _) -> find_vars x; find_vars y; *) 22 | (* | Id (name, typ) -> if List.mem vars name then Ctx.update ctx name typ else () *) 23 | (* in *) 24 | (* find_vars body'; *) 25 | (* let vars' = List.map vars ~f:(fun var -> *) 26 | (* match Ctx.lookup ctx var with *) 27 | (* | Some typ -> var, typ *) 28 | (* | None -> verify_error "Could not find type for constraint var.") in *) 29 | (* body', vars' *) 30 | 31 | (* let rec expand ctx expr = *) 32 | (* let exp e = expand ctx e in *) 33 | (* let exp_all es = List.map ~f:exp es in *) 34 | (* match expr with *) 35 | (* | `Id name -> (match Ctx.lookup ctx name with Some expr' -> expr' | None -> expr) *) 36 | (* | `List elems -> `List (exp_all elems) *) 37 | (* | `Let (name, bound, body) -> expand (Ctx.bind ctx name (expand ctx bound)) body *) 38 | (* | `Lambda (args, body) -> *) 39 | (* let ctx' = List.fold args ~init:ctx ~f:(fun ctx' arg -> Ctx.unbind ctx' arg) in *) 40 | (* `Lambda (args, expand ctx' body) *) 41 | (* | `Apply (func, args) -> *) 42 | (* let args' = exp_all args in *) 43 | (* let func' = exp func in *) 44 | (* (match func' with *) 45 | (* | `Lambda (lambda_args, body) -> *) 46 | (* let ctx' = List.fold2_exn lambda_args args' ~init:ctx *) 47 | (* ~f:(fun ctx' arg_name arg_val -> Ctx.bind ctx' arg_name arg_val) in *) 48 | (* expand ctx' body *) 49 | (* | _ -> verify_error (sprintf "Tried to apply a non-lambda expression: %s" *) 50 | (* (expr_to_string expr))) *) 51 | (* | `Op (op, args) -> `Op (op, exp_all args) *) 52 | (* | `Num _ | `Bool _ -> expr *) 53 | 54 | (* let rec typ_to_z3 (zctx: Z3.context) (typ: typ) : Z3.Sort.sort = *) 55 | (* match typ with *) 56 | (* | Const_t Num_t -> Z3.Arithmetic.Integer.mk_sort zctx *) 57 | (* | Const_t Bool_t -> Z3.Boolean.mk_sort zctx *) 58 | (* | App_t ("list", [elem_typ]) -> Z3.Z3List.mk_list_s zctx (typ_to_string typ) (typ_to_z3 zctx elem_typ) *) 59 | (* | App_t ("list", _) -> verify_error "Wrong number of arguments to list." *) 60 | (* | App_t (const, _) -> verify_error (sprintf "Type constructor %s is not supported." const) *) 61 | (* | Var_t {contents = Link typ'} -> typ_to_z3 zctx typ' *) 62 | (* | Var_t {contents = Free _} *) 63 | (* | Var_t {contents = Quant _} *) 64 | (* | Arrow_t _ -> verify_error (sprintf "Z3 types must be concrete: %s" (typ_to_string typ)) *) 65 | 66 | (* let typed_id_to_z3 zctx tid = *) 67 | (* let id, typ = tid in *) 68 | (* let sort = typ_to_z3 zctx typ in *) 69 | (* Z3.Expr.mk_const_s zctx id sort *) 70 | 71 | (* let rec expr_to_z3 (zctx: Z3.context) z3ectx expr = *) 72 | (* match expr with *) 73 | (* | Num (x, _) -> Z3.Arithmetic.Integer.mk_numeral_i zctx x *) 74 | (* | Bool (x, _) -> Z3.Boolean.mk_val zctx x *) 75 | (* | List (x, t) -> *) 76 | (* let sort = typ_to_z3 zctx t in *) 77 | (* let nil = Z3.Z3List.nil sort in *) 78 | (* let cons = Z3.Z3List.get_cons_decl sort in *) 79 | (* List.fold_right x ~init:nil *) 80 | (* ~f:(fun elem acc -> *) 81 | (* let z3_elem = expr_to_z3 zctx z3ectx elem in *) 82 | (* Z3.FuncDecl.apply cons [z3_elem; acc]) *) 83 | (* | Id (x, _) -> Ctx.lookup_exn z3ectx x *) 84 | (* | Op ((op, args), _) -> *) 85 | (* let open Op in *) 86 | (* (match op, (List.map ~f:(expr_to_z3 zctx z3ectx) args) with *) 87 | (* | Plus, z3_args -> Z3.Arithmetic.mk_add zctx z3_args *) 88 | (* | Minus, z3_args-> Z3.Arithmetic.mk_sub zctx z3_args *) 89 | (* | Mul, z3_args -> Z3.Arithmetic.mk_mul zctx z3_args *) 90 | (* | Div, [a1; a2] -> Z3.Arithmetic.mk_div zctx a1 a2 *) 91 | (* | Mod, [a1; a2] -> Z3.Arithmetic.Integer.mk_mod zctx a1 a2 *) 92 | (* | Eq, [a1; a2] -> Z3.Boolean.mk_eq zctx a1 a2 *) 93 | (* | Neq, [a1; a2] -> Z3.Boolean.mk_not zctx (Z3.Boolean.mk_eq zctx a1 a2) *) 94 | (* | Lt, [a1; a2] -> Z3.Arithmetic.mk_lt zctx a1 a2 *) 95 | (* | Leq, [a1; a2] -> Z3.Arithmetic.mk_le zctx a1 a2 *) 96 | (* | Gt, [a1; a2] -> Z3.Arithmetic.mk_gt zctx a1 a2 *) 97 | (* | Geq, [a1; a2] -> Z3.Arithmetic.mk_ge zctx a1 a2 *) 98 | (* | And, z3_args -> Z3.Boolean.mk_and zctx z3_args *) 99 | (* | Or, z3_args -> Z3.Boolean.mk_or zctx z3_args *) 100 | (* | Not, [a] -> Z3.Boolean.mk_not zctx a *) 101 | (* | If, [a; b; c] -> Z3.Boolean.mk_ite zctx a b c *) 102 | (* | Cons, [a; b] -> let sort = Z3.Expr.get_sort b in *) 103 | (* let cons = Z3.Z3List.get_cons_decl sort in *) 104 | (* Z3.FuncDecl.apply cons [a; b] *) 105 | (* | Car, [a] -> let sort = Z3.Expr.get_sort a in *) 106 | (* let head = Z3.Z3List.get_head_decl sort in *) 107 | (* Z3.FuncDecl.apply head [a] *) 108 | (* | Cdr, [a] -> let sort = Z3.Expr.get_sort a in *) 109 | (* let tail = Z3.Z3List.get_tail_decl sort in *) 110 | (* Z3.FuncDecl.apply tail [a] *) 111 | (* | _ -> verify_error "Attempted to convert unsupported operator to Z3.") *) 112 | (* | Lambda _ *) 113 | (* | Let _ *) 114 | (* | Apply _ -> verify_error "(lambda, let, apply) are not supported by Z3." *) 115 | 116 | let verify_example ?(ctx = Ctx.empty ()) ?(limit = 100) (target : expr -> expr) 117 | (example : example) : bool = 118 | let input, result = example in 119 | let eval = Eval.eval ~recursion_limit:limit ctx in 120 | try eval (target input) = eval result with 121 | | Eval.RuntimeError _ -> 122 | (* printf "Runtime error \"%s\" in %s\n" msg (expr_to_string (target input)); *) 123 | false 124 | | Ctx.UnboundError name -> 125 | printf "Unbound %s in %s\n" name (Expr.to_string (target input)) ; 126 | false 127 | 128 | let verify_examples ?(ctx = Ctx.empty ()) ?(limit = 100) target examples = 129 | List.for_all examples ~f:(verify_example ~ctx ~limit target) 130 | 131 | (* let verify_constraint (zctx: Z3.context) (target: expr -> expr) (constr: constr) : bool = *) 132 | (* let open Z3.Solver in *) 133 | (* let solver = mk_simple_solver zctx in *) 134 | 135 | (* (\* Wrap the constraint in a let containing the definition of the *) 136 | (* target function and then expand. *\) *) 137 | (* let body, ids = *) 138 | (* let body', ids' = constr in *) 139 | (* typed_constr ((expand (Ctx.empty ()) (target body')), ids') in *) 140 | 141 | (* (\* Generate a correctly typed Z3 constant for each unbound id in the constraint. *\) *) 142 | (* let z3_consts = List.map ids ~f:(typed_id_to_z3 zctx) in *) 143 | 144 | (* (\* Convert constraint body to a Z3 expression. *\) *) 145 | (* let z3_constr_body = *) 146 | (* let ctx = List.fold2_exn ids z3_consts *) 147 | (* ~init:(Ctx.empty ()) *) 148 | (* ~f:(fun acc (id, _) z3c -> Ctx.bind acc id z3c) in *) 149 | (* expr_to_z3 zctx ctx body in *) 150 | 151 | (* (\* let _ = Printf.printf "%s\n" (Z3.Expr.to_string z3_constr_body) in *\) *) 152 | 153 | (* (\* Add the constraint to the solver and check. *\) *) 154 | (* add solver [Z3.Boolean.mk_not zctx z3_constr_body]; *) 155 | (* match check solver [] with *) 156 | (* | UNSATISFIABLE -> true *) 157 | (* | UNKNOWN -> verify_error "Z3 returned unknown." *) 158 | (* | SATISFIABLE -> false *) 159 | 160 | (* let verify (examples: example list) (constraints: constr list) (target: expr -> expr) : status = *) 161 | (* if verify_examples target examples *) 162 | (* then *) 163 | (* let zctx = Z3.mk_context [] in *) 164 | (* try *) 165 | (* if List.for_all constraints ~f:(verify_constraint zctx target) *) 166 | (* then Valid *) 167 | (* else Invalid *) 168 | (* with VerifyError msg -> *) 169 | (* Printf.printf "%s\n" msg; *) 170 | (* Error *) 171 | (* else Invalid *) 172 | -------------------------------------------------------------------------------- /paramils/crossvalidate.py: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env python3 2 | 3 | ''' 4 | usage: 5 | crossvalidate.py setup [--test-perc PERC] [--num-tests TESTS] [--seed SEED] [--l2-path FILE] [--timeout-path FILE] OUT_DIR 6 | crossvalidate.py run OUT_DIR 7 | crossvalidate.py write-costs OUT_DIR 8 | crossvalidate.py benchmark [--l2-path FILE] [--timeout-path FILE] OUT_DIR 9 | 10 | Options: 11 | --test-perc PERC Percentage of instances to use as test set [default: 0.3]. 12 | --num-tests TESTS Number of individual tests to run [default: 8]. 13 | --seed SEED Random seed [default: 0]. 14 | --l2-path FILE Path to L2. 15 | --timeout-path FILE Path to timeout. 16 | ''' 17 | 18 | from docopt import docopt 19 | import json 20 | import math 21 | import os 22 | import random 23 | import re 24 | import shutil 25 | import subprocess 26 | import sys 27 | import time 28 | import tmuxp 29 | 30 | def relpath(path): 31 | return os.path.abspath(os.path.join(os.path.dirname(__file__), path)) 32 | 33 | DEFAULT_SPECS_DIR = relpath('../../specs') 34 | DEFAULT_L2_PATH = relpath('../../l2.native') 35 | DEFAULT_TIMEOUT_PATH_PREFIX = relpath('../../timeout') 36 | DEFAULT_BENCHMARK_PATH = relpath('../benchmark.py') 37 | 38 | RESOURCES = [ 39 | 'params.txt', 40 | ] 41 | RESOURCES = [relpath(f) for f in RESOURCES] 42 | 43 | CUTOFF_TIME = 10 44 | 45 | SCENARIO = '''algo = {algo} "{l2_path}" "{timeout_path}" 46 | execdir = . 47 | deterministic = 1 48 | run_obj = runtime 49 | overall_obj = mean 50 | cutoff_time = {cutoff_time} 51 | cutoff_length = max 52 | tunerTimeout = 30000 53 | paramfile = params.txt 54 | outdir = . 55 | instance_file = train-instances.txt 56 | test_instance_file = test-instances.txt 57 | ''' 58 | 59 | L2_PATH = None 60 | TIMEOUT_PATH = None 61 | BENCHMARK_PATH = None 62 | SPECS_DIR = None 63 | OUT_DIR = None 64 | NUM_TESTS = None 65 | TEST_PERC = None 66 | 67 | def shuffle_split(items, num_splits, test_size): 68 | num_test = math.floor(test_size * len(items)) 69 | num_train = len(items) - num_test 70 | 71 | for i in range(num_splits): 72 | items_shuf = random.sample(items, len(items)) 73 | yield items_shuf[:num_train], items_shuf[num_train:] 74 | 75 | def write_instances(items, output_fn): 76 | with open(output_fn, 'w') as out: 77 | out.write('\n'.join(items)) 78 | 79 | def setup(): 80 | all_instances = [os.path.abspath(os.path.join(SPECS_DIR, f)) for f in os.listdir(SPECS_DIR)] 81 | 82 | os.makedirs(OUT_DIR, exist_ok=True) 83 | 84 | for i, instances in enumerate(shuffle_split(all_instances, NUM_TESTS, TEST_PERC)): 85 | test_dir = os.path.join(OUT_DIR, 'run{}'.format(i)) 86 | 87 | os.makedirs(test_dir, exist_ok=True) 88 | for f in RESOURCES: 89 | shutil.copy(f, test_dir) 90 | 91 | train, test = instances 92 | write_instances(train, os.path.join(test_dir, 'train-instances.txt')) 93 | write_instances(test, os.path.join(test_dir, 'test-instances.txt')) 94 | 95 | with open(os.path.join(test_dir, 'scenario.txt'), 'w') as f: 96 | kwargs = { 97 | 'algo': relpath('l2_wrapper.py'), 98 | 'l2_path': L2_PATH, 99 | 'timeout_path': TIMEOUT_PATH, 100 | 'cutoff_time': CUTOFF_TIME 101 | } 102 | f.write(SCENARIO.format(**kwargs)) 103 | 104 | def cost_of_params(kv): 105 | return { 106 | "num": kv['num'], 107 | "bool": kv['bool'], 108 | "hole": kv['hole'], 109 | "lambda": kv['lambda'], 110 | "let": kv['let'], 111 | "list": kv['list'], 112 | "tree": kv['tree'], 113 | "var": kv['var_'], 114 | "call": { 115 | "+": kv['add'], 116 | "-": kv['sub'], 117 | "*": kv['mult'], 118 | "/": kv['div'], 119 | "%": kv['mod'], 120 | "=": kv['eq'], 121 | "!=": kv['neq'], 122 | "<": kv['lt'], 123 | "<=": kv['le'], 124 | ">": kv['gt'], 125 | ">=": kv['ge'], 126 | "&": kv['and'], 127 | "|": kv['or'], 128 | "~": kv['not'], 129 | "if": kv['if'], 130 | "rcons": kv['rcons'], 131 | "cons": kv['cons'], 132 | "car": kv['car'], 133 | "cdr": kv['cdr'], 134 | "tree": kv['tree_op'], 135 | "children": kv['children'], 136 | "value": kv['value'], 137 | "foldr": kv["foldr"], 138 | "foldl": kv["foldl"], 139 | "map": kv["map"], 140 | "filter": kv["filter"], 141 | "mapt": kv["mapt"], 142 | "foldt": kv["foldt"], 143 | "merge": kv["merge"], 144 | "take": kv["take"], 145 | "zip": kv["zip"], 146 | "intersperse": kv["intersperse"], 147 | "append": kv["append"], 148 | "reverse": kv["reverse"], 149 | "concat": kv["concat"], 150 | "drop": kv["drop"], 151 | "sort": kv["sort"], 152 | "dedup": kv["dedup"], 153 | }, 154 | "call_default": 1, 155 | } 156 | 157 | def write_costs(): 158 | traj_reg = re.compile('^.*-traj_\d+\.csv$') 159 | 160 | for run_dir in [os.path.join(OUT_DIR, d) for d in os.listdir(OUT_DIR)]: 161 | trajfile = [os.path.join(run_dir, f) for f in os.listdir(run_dir) if traj_reg.match(f)][0] 162 | 163 | with open(trajfile, 'r') as f: 164 | cost_params = f.readlines()[-1].strip().split(', ')[5:] 165 | costs = {} 166 | for cp in cost_params: 167 | parts = cp.split('=') 168 | name = parts[0] 169 | cost = int(parts[1].strip("'")) 170 | costs[name] = cost 171 | 172 | cost_fn = os.path.join(run_dir, 'cost.json') 173 | with open(cost_fn, 'w') as cost_file: 174 | json.dump(cost_of_params(costs), cost_file) 175 | 176 | def tmux_parallel(cmds, session_name): 177 | server = tmuxp.Server() 178 | session = server.new_session(session_name) 179 | 180 | for cmd in cmds: 181 | pane = session.new_window().attached_pane() 182 | for ks in cmd: 183 | pane.send_keys(ks, enter=True) 184 | 185 | def run(): 186 | cmds = [] 187 | for run_dir in os.listdir(OUT_DIR): 188 | cmd = [ 189 | "cd {}".format(os.path.join(OUT_DIR, run_dir)), 190 | 'paramils -scenariofile scenario.txt -numRun 0' 191 | ] 192 | cmds.append(cmd) 193 | session_name = 'paramils' 194 | tmux_parallel(cmds, session_name) 195 | print('To attach to paramils session run: tmux attach -t {}'.format(session_name)) 196 | 197 | def benchmark(): 198 | cmds = [] 199 | for run_dir in os.listdir(OUT_DIR): 200 | cmd = [ 201 | "cd {}".format(os.path.join(OUT_DIR, run_dir)), 202 | '{} --l2 {} --l2-args "--cost cost.json" --timeout {} {}/*'\ 203 | .format(BENCHMARK_PATH, 204 | L2_PATH, 205 | TIMEOUT_PATH, 206 | SPECS_DIR) 207 | ] 208 | cmds.append(cmd) 209 | session_name = 'benchmark' 210 | tmux_parallel(cmds, session_name) 211 | print('To attach to benchmark session run: tmux attach -t {}'.format(session_name)) 212 | 213 | def main(): 214 | global NUM_TESTS 215 | global TEST_PERC 216 | global BENCHMARK_PATH 217 | global L2_PATH 218 | global TIMEOUT_PATH 219 | global OUT_DIR 220 | global SPECS_DIR 221 | 222 | args = docopt(__doc__) 223 | 224 | random.seed(int(args['--seed'])) 225 | 226 | OUT_DIR = os.path.abspath(args['OUT_DIR']) 227 | NUM_TESTS = int(args['--num-tests']) 228 | TEST_PERC = float(args['--test-perc']) 229 | SPECS_DIR = DEFAULT_SPECS_DIR 230 | BENCHMARK_PATH = DEFAULT_BENCHMARK_PATH 231 | 232 | if args['--l2-path'] is None: 233 | L2_PATH = DEFAULT_L2_PATH 234 | else: 235 | L2_PATH = os.abspath(args['--l2-path']) 236 | 237 | if args['--timeout-path'] is None: 238 | if sys.platform == 'linux': 239 | TIMEOUT_PATH = DEFAULT_TIMEOUT_PATH_PREFIX + '_linux.native' 240 | elif sys.platform == 'darwin': 241 | TIMEOUT_PATH = DEFAULT_TIMEOUT_PATH_PREFIX + '_osx.native' 242 | else: 243 | print('Unsupported system: {}'.format(sys.platform)) 244 | exit(-1) 245 | else: 246 | TIMEOUT_PATH = os.path.abspath(args['--timeout-path']) 247 | 248 | if args['setup']: 249 | setup() 250 | elif args['write-costs']: 251 | write_costs() 252 | elif args['run']: 253 | run() 254 | elif args['benchmark']: 255 | benchmark() 256 | 257 | if __name__ == '__main__': 258 | main() 259 | -------------------------------------------------------------------------------- /paramils/instances.txt: -------------------------------------------------------------------------------- 1 | ../repo/specs/Reverse.json 2 | ../repo/specs/add.json 3 | ../repo/specs/append.json 4 | ../repo/specs/appendt.json 5 | ../repo/specs/concat.json 6 | ../repo/specs/count_leaves.json 7 | ../repo/specs/count_nodes.json 8 | ../repo/specs/dropmax.json 9 | ../repo/specs/dupli.json 10 | ../repo/specs/evens.json 11 | ../repo/specs/flatten.json 12 | ../repo/specs/flattenl.json 13 | ../repo/specs/height.json 14 | ../repo/specs/incrs.json 15 | ../repo/specs/incrt.json 16 | ../repo/specs/join.json 17 | ../repo/specs/largest_n.json 18 | ../repo/specs/last.json 19 | ../repo/specs/leaves.json 20 | ../repo/specs/length.json 21 | ../repo/specs/max.json 22 | ../repo/specs/maxt.json 23 | ../repo/specs/member.json 24 | ../repo/specs/membert.json 25 | ../repo/specs/multfirst.json 26 | ../repo/specs/multlast.json 27 | ../repo/specs/prependt.json 28 | ../repo/specs/replacet.json 29 | ../repo/specs/searchnodes.json 30 | ../repo/specs/shiftl.json 31 | ../repo/specs/shiftr.json 32 | ../repo/specs/sum.json 33 | ../repo/specs/sumnodes.json 34 | ../repo/specs/sums.json 35 | ../repo/specs/sumt.json 36 | -------------------------------------------------------------------------------- /paramils/l2_wrapper.py: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env python3 2 | 3 | ''' 4 | usage: l2_wrapper.py ... 5 | ''' 6 | 7 | import sys 8 | from subprocess import check_output 9 | import json 10 | import tempfile 11 | 12 | MEMORY_LIMIT = 2000 13 | 14 | def cost_of_params(params): 15 | kv = {} 16 | for i in range(0, len(params), 2): 17 | kv[params[i][1:]] = int(params[i+1]) 18 | 19 | return { 20 | "num": kv['num'], 21 | "bool": kv['bool'], 22 | "hole": kv['hole'], 23 | "lambda": kv['lambda'], 24 | "let": kv['let'], 25 | "list": kv['list'], 26 | "tree": kv['tree'], 27 | "var": kv['var_'], 28 | "call": { 29 | "+": kv['add'], 30 | "-": kv['sub'], 31 | "*": kv['mult'], 32 | "/": kv['div'], 33 | "%": kv['mod'], 34 | "=": kv['eq'], 35 | "!=": kv['neq'], 36 | "<": kv['lt'], 37 | "<=": kv['le'], 38 | ">": kv['gt'], 39 | ">=": kv['ge'], 40 | "&": kv['and'], 41 | "|": kv['or'], 42 | "~": kv['not'], 43 | "if": kv['if'], 44 | "rcons": kv['rcons'], 45 | "cons": kv['cons'], 46 | "car": kv['car'], 47 | "cdr": kv['cdr'], 48 | "tree": kv['tree_op'], 49 | "children": kv['children'], 50 | "value": kv['value'], 51 | "foldr": kv["foldr"], 52 | "foldl": kv["foldl"], 53 | "map": kv["map"], 54 | "filter": kv["filter"], 55 | "mapt": kv["mapt"], 56 | "foldt": kv["foldt"], 57 | "merge": kv["merge"], 58 | "take": kv["take"], 59 | "zip": kv["zip"], 60 | "intersperse": kv["intersperse"], 61 | "append": kv["append"], 62 | "reverse": kv["reverse"], 63 | "concat": kv["concat"], 64 | "drop": kv["drop"], 65 | "sort": kv["sort"], 66 | "dedup": kv["dedup"], 67 | }, 68 | "call_default": 1, 69 | } 70 | 71 | if __name__ == '__main__': 72 | args = sys.argv 73 | l2_path = args[1] 74 | timeout_path = args[2] 75 | testcase = args[3] 76 | cutoff_time = args[5] 77 | seed = args[7] 78 | params = args[8:] 79 | 80 | with tempfile.NamedTemporaryFile() as f: 81 | cost_str = json.dumps(cost_of_params(params)) 82 | f.write(cost_str.encode()) 83 | f.flush() 84 | 85 | cmd = [ 86 | timeout_path, 87 | '-m', str(MEMORY_LIMIT), 88 | '-t', cutoff_time, 89 | '--machine-readable', 90 | '--', 91 | l2_path, 'synth', 92 | '--cost', f.name, 93 | '--engine', 'v2', 94 | testcase 95 | ] 96 | out = check_output(cmd) 97 | out = json.loads(out.decode()) 98 | 99 | if out['status'] == 'success': 100 | print('Result for ParamILS: SAT, {}, -1, -1, {}'.format(out['runtime'], seed)) 101 | else: 102 | print(out) 103 | print('Result for ParamILS: TIMEOUT, {}, -1, -1, {}'.format(out['runtime'], seed)) 104 | 105 | 106 | 107 | 108 | 109 | 110 | 111 | -------------------------------------------------------------------------------- /paramils/params.txt: -------------------------------------------------------------------------------- 1 | num {1,2,3,4,5,6,7,8,9,10} [1] 2 | bool {1,2,3,4,5,6,7,8,9,10} [1] 3 | hole {1,2,3,4,5,6,7,8,9,10} [1] 4 | lambda {1,2,3,4,5,6,7,8,9,10} [1] 5 | let {1,2,3,4,5,6,7,8,9,10} [1] 6 | list {1,2,3,4,5,6,7,8,9,10} [1] 7 | tree {1,2,3,4,5,6,7,8,9,10} [1] 8 | var_ {1,2,3,4,5,6,7,8,9,10} [1] 9 | call {1,2,3,4,5,6,7,8,9,10} [1] 10 | add {1,2,3,4,5,6,7,8,9,10} [1] 11 | sub {1,2,3,4,5,6,7,8,9,10} [1] 12 | mult {1,2,3,4,5,6,7,8,9,10} [1] 13 | div {1,2,3,4,5,6,7,8,9,10} [1] 14 | mod {1,2,3,4,5,6,7,8,9,10} [1] 15 | eq {1,2,3,4,5,6,7,8,9,10} [1] 16 | neq {1,2,3,4,5,6,7,8,9,10} [1] 17 | lt {1,2,3,4,5,6,7,8,9,10} [1] 18 | le {1,2,3,4,5,6,7,8,9,10} [1] 19 | gt {1,2,3,4,5,6,7,8,9,10} [1] 20 | ge {1,2,3,4,5,6,7,8,9,10} [1] 21 | and {1,2,3,4,5,6,7,8,9,10} [1] 22 | or {1,2,3,4,5,6,7,8,9,10} [1] 23 | not {1,2,3,4,5,6,7,8,9,10} [1] 24 | if {1,2,3,4,5,6,7,8,9,10} [1] 25 | rcons {1,2,3,4,5,6,7,8,9,10} [1] 26 | cons {1,2,3,4,5,6,7,8,9,10} [1] 27 | car {1,2,3,4,5,6,7,8,9,10} [1] 28 | cdr {1,2,3,4,5,6,7,8,9,10} [1] 29 | tree_op {1,2,3,4,5,6,7,8,9,10} [1] 30 | children {1,2,3,4,5,6,7,8,9,10} [1] 31 | value {1,2,3,4,5,6,7,8,9,10} [1] 32 | foldr {1,2,3,4,5,6,7,8,9,10} [1] 33 | foldl {1,2,3,4,5,6,7,8,9,10} [1] 34 | map {1,2,3,4,5,6,7,8,9,10} [1] 35 | filter {1,2,3,4,5,6,7,8,9,10} [1] 36 | mapt {1,2,3,4,5,6,7,8,9,10} [1] 37 | foldt {1,2,3,4,5,6,7,8,9,10} [1] 38 | merge {1,2,3,4,5,6,7,8,9,10} [1] 39 | take {1,2,3,4,5,6,7,8,9,10} [1] 40 | zip {1,2,3,4,5,6,7,8,9,10} [1] 41 | intersperse {1,2,3,4,5,6,7,8,9,10} [1] 42 | append {1,2,3,4,5,6,7,8,9,10} [1] 43 | reverse {1,2,3,4,5,6,7,8,9,10} [1] 44 | concat {1,2,3,4,5,6,7,8,9,10} [1] 45 | drop {1,2,3,4,5,6,7,8,9,10} [1] 46 | sort {1,2,3,4,5,6,7,8,9,10} [1] 47 | dedup {1,2,3,4,5,6,7,8,9,10} [1] 48 | 49 | -------------------------------------------------------------------------------- /paramils/scenario.txt: -------------------------------------------------------------------------------- 1 | algo = ../repo/src/l2_wrapper.py 2 | execdir = . 3 | deterministic = 1 4 | run_obj = runtime 5 | overall_obj = mean 6 | cutoff_time = 10 7 | cutoff_length = max 8 | tunerTimeout = 300 9 | paramfile = ../repo/src/params.txt 10 | outdir = . 11 | instance_file = instances.txt 12 | test_instance_file = instances.txt 13 | -------------------------------------------------------------------------------- /test/collections_tests.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | open OUnit2 3 | open L2 4 | open Collections 5 | 6 | let tree_max_tests = 7 | let module T = Tree in 8 | "tree-max-tests" 9 | >::: List.map 10 | ~f:(fun (input, output) -> 11 | test_case (fun _ -> assert_equal (Tree.max ~cmp:Int.compare input) output) 12 | ) 13 | [ (T.Empty, None) 14 | ; (T.Node (0, []), Some 0) 15 | ; (T.Node (0, [T.Node (1, []); T.Node (0, [])]), Some 1) 16 | ; (T.Node (1, [T.Node (0, []); T.Node (0, [])]), Some 1) 17 | ; (T.Node (1, [T.Node (0, []); T.Node (2, [])]), Some 2) ] 18 | 19 | let tree_size_tests = 20 | let module T = Tree in 21 | "tree-size-tests" 22 | >::: List.map 23 | ~f:(fun (input, output) -> 24 | test_case (fun _ -> assert_equal (Tree.size input) output) ) 25 | [ (T.Empty, 1) 26 | ; (T.Node (0, []), 1) 27 | ; (T.Node (0, [T.Node (1, []); T.Node (0, [])]), 3) ] 28 | 29 | let tree_map_tests = 30 | let module T = Tree in 31 | "tree-map-tests" 32 | >::: List.map 33 | ~f:(fun (tree, f, output) -> 34 | test_case (fun _ -> assert_equal (Tree.map tree ~f) output) ) 35 | [ (T.Empty, (fun x -> x), T.Empty) 36 | ; (T.Node (0, []), (fun x -> x), T.Node (0, [])) 37 | ; (T.Node (0, []), (fun x -> x + 1), T.Node (1, [])) 38 | ; ( T.Node (0, [T.Node (1, []); T.Node (0, [])]) 39 | , (fun x -> x + 1) 40 | , T.Node (1, [T.Node (2, []); T.Node (1, [])]) ) ] 41 | 42 | let tree_tests = "tree-tests" >::: [tree_max_tests; tree_size_tests; tree_map_tests] 43 | 44 | let tests = "collections-tests" >::: [tree_tests] 45 | -------------------------------------------------------------------------------- /test/dune: -------------------------------------------------------------------------------- 1 | (test 2 | (name tests) 3 | (libraries l2 oUnit core core_extended yojson hashcons) 4 | (preprocess (pps ppx_jane))) -------------------------------------------------------------------------------- /test/eval_tests.ml: -------------------------------------------------------------------------------- 1 | open OUnit2 2 | open L2 3 | open Collections 4 | 5 | (** Test a function in the standard evaluation context. *) 6 | let test_l2_function_single fun_name input_strs result_str = 7 | let inputs = List.map ~f:Expr.of_string_exn input_strs in 8 | let result = Expr.of_string_exn result_str in 9 | let ctx = Eval.stdlib_vctx in 10 | assert_equal ~printer:Eval.value_to_string (Eval.eval ctx result) 11 | (Eval.eval ctx (`Apply (`Id fun_name, inputs))) 12 | 13 | let test_l2_function fun_name cases = 14 | fun_name ^ "-tests" 15 | >::: List.map 16 | ~f:(fun (input_strs, result_str) -> 17 | test_case (fun _ -> 18 | test_l2_function_single fun_name input_strs result_str ) ) 19 | cases 20 | 21 | let merge_tests = 22 | test_l2_function "merge" 23 | [ (["[]"; "[3 4 5]"], "[3 4 5]") 24 | ; (["[1 2 3]"; "[]"], "[1 2 3]") 25 | ; (["[1 2 3]"; "[3 4 5]"], "[1 2 3 3 4 5]") ] 26 | 27 | let intersperse_tests = 28 | test_l2_function "intersperse" 29 | [ (["[]"; "1"], "[]") 30 | ; (["[2]"; "1"], "[2]") 31 | ; (["[2 3]"; "1"], "[2 1 3]") 32 | ; (["[2 3 4]"; "1"], "[2 1 3 1 4]") ] 33 | 34 | let append_tests = 35 | test_l2_function "append" 36 | [ (["[]"; "[]"], "[]") 37 | ; (["[1]"; "[]"], "[1]") 38 | ; (["[]"; "[1]"], "[1]") 39 | ; (["[2]"; "[1]"], "[2 1]") ] 40 | 41 | let reverse_tests = 42 | test_l2_function "reverse" 43 | [(["[]"], "[]"); (["[1]"], "[1]"); (["[1 2 3]"], "[3 2 1]")] 44 | 45 | let concat_tests = 46 | test_l2_function "concat" 47 | [ (["[]"], "[]") 48 | ; (["[[] [] []]"], "[]") 49 | ; (["[[1 2 3] [4 5] [7]]"], "[1 2 3 4 5 7]") ] 50 | 51 | let drop_tests = 52 | test_l2_function "drop" 53 | [ (["[]"; "0"], "[]") 54 | ; (["[1 2]"; "0"], "[1 2]") 55 | ; (["[1 2 3]"; "1"], "[2 3]") 56 | ; (["[1 2 3]"; "2"], "[3]") 57 | ; (["[1 2 3]"; "3"], "[]") ] 58 | 59 | let take_tests = 60 | test_l2_function "take" 61 | [ (["[]"; "0"], "[]") 62 | ; (["[1 2]"; "0"], "[]") 63 | ; (["[1 2 3]"; "1"], "[1]") 64 | ; (["[1 2 3]"; "2"], "[1 2]") 65 | ; (["[1 2 3]"; "3"], "[1 2 3]") ] 66 | 67 | let sort_tests = 68 | test_l2_function "sort" 69 | [ (["[]"], "[]") 70 | ; (["[1]"], "[1]") 71 | ; (["[1 2 3]"], "[1 2 3]") 72 | ; (["[3 2 1]"], "[1 2 3]") ] 73 | 74 | let dedup_tests = 75 | test_l2_function "dedup" 76 | [ (["[]"], "[]") 77 | ; (["[1]"], "[1]") 78 | ; (["[1 2 3]"], "[1 2 3]") 79 | ; (["[3 2 1]"], "[1 2 3]") 80 | ; (["[1 1]"], "[1]") 81 | ; (["[1 2 1]"], "[1 2]") ] 82 | 83 | let tests = 84 | "eval-tests" 85 | >::: [ merge_tests 86 | ; intersperse_tests 87 | ; append_tests 88 | ; reverse_tests 89 | ; concat_tests 90 | ; drop_tests 91 | ; take_tests 92 | ; sort_tests 93 | ; dedup_tests ] 94 | -------------------------------------------------------------------------------- /test/hypothesis_tests.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | open OUnit2 3 | open L2 4 | open Tests_common 5 | open Hypothesis 6 | 7 | let static_distance_tests = 8 | "static-distance" 9 | >::: [ "create" 10 | >::: [ test_case (fun ctxt -> 11 | let sd = StaticDistance.create ~distance:1 ~index:2 in 12 | assert_equal ~ctxt ~printer:Int.to_string 13 | (StaticDistance.distance sd) 1 ; 14 | assert_equal ~ctxt ~printer:Int.to_string 15 | (StaticDistance.index sd) 2 ) 16 | ; test_case (fun _ -> 17 | assert_raises 18 | ~msg:"Bad arguments should raise Invalid_argument." 19 | (Invalid_argument "Argument out of range.") (fun () -> 20 | StaticDistance.create ~distance:(-1) ~index:1 ) ; 21 | assert_raises 22 | ~msg:"Bad arguments should raise Invalid_argument." 23 | (Invalid_argument "Argument out of range.") (fun () -> 24 | StaticDistance.create ~distance:1 ~index:(-1) ) ) ] 25 | ; mk_equality_tests "args" StaticDistance.args 26 | ~printer:(fun a -> 27 | Sexp.to_string (List.sexp_of_t StaticDistance.sexp_of_t a) ) 28 | [ (0, []) 29 | ; (1, [StaticDistance.create ~distance:1 ~index:1]) 30 | ; ( 2 31 | , [ StaticDistance.create ~distance:1 ~index:1 32 | ; StaticDistance.create ~distance:1 ~index:2 ] ) ] 33 | ; "increment_scope" 34 | >::: [ test_case (fun ctxt -> 35 | let sd = 36 | StaticDistance.create ~distance:1 ~index:2 37 | |> StaticDistance.increment_scope 38 | in 39 | assert_equal ~ctxt ~printer:Int.to_string 40 | (StaticDistance.distance sd) 2 ; 41 | assert_equal ~ctxt ~printer:Int.to_string 42 | (StaticDistance.index sd) 2 ) ] ] 43 | 44 | let top = Specification.top 45 | 46 | let constant_cm = CostModel.constant 1 47 | 48 | let cost_model_tests = 49 | "cost-model" 50 | >::: [ test_case (fun ctxt -> 51 | let h = Hypothesis.num constant_cm 1 top in 52 | assert_equal ~ctxt ~printer:Int.to_string 1 (Hypothesis.cost h) ) 53 | ; test_case (fun ctxt -> 54 | let one = Hypothesis.num constant_cm 1 top in 55 | let h = 56 | Hypothesis.apply constant_cm 57 | (Hypothesis.id_name constant_cm "+" top) 58 | [one; one] top 59 | in 60 | assert_equal ~ctxt ~printer:Int.to_string 4 (Hypothesis.cost h) ) ] 61 | 62 | let spec_tests = 63 | let module Sp = Specification in 64 | "specifications" 65 | >::: [ test_case (fun _ -> 66 | let module FE = FunctionExamples in 67 | let s1 = 68 | FE.of_input_output_list_exn [([`Num 0], `Num 1)] |> FE.to_spec 69 | in 70 | let s2 = 71 | FE.of_input_output_list_exn [([`Num 0], `Num 2)] |> FE.to_spec 72 | in 73 | assert_bool "specs are not equal" (Sp.compare s1 s2 <> 0) ) 74 | ; test_case (fun _ -> 75 | let module FE = FunctionExamples in 76 | let s1 = 77 | FE.of_input_output_list_exn [([`Num 0], `Num 1)] |> FE.to_spec 78 | in 79 | let s2 = 80 | FE.of_input_output_list_exn [([`Num 0], `Num 1)] |> FE.to_spec 81 | in 82 | assert_bool "specs are equal" (Sp.compare s1 s2 = 0) ) ] 83 | 84 | let tests = "hypothesis" >::: [static_distance_tests; cost_model_tests; spec_tests] 85 | -------------------------------------------------------------------------------- /test/sexp_parser_tests.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | open OUnit2 3 | open L2 4 | open Tests_common 5 | open Ast 6 | open Infer 7 | 8 | let test_parse_expr = 9 | let open Collections.Tree in 10 | make_tests ~in_f:Expr.of_string_exn ~out_f:ident ~in_str:ident 11 | ~out_str:Expr.to_string ~res_str:Expr.to_string "parse_expr" 12 | [ ("1", `Num 1) 13 | ; ("#t", `Bool true) 14 | ; ("#f", `Bool false) 15 | ; ("[]", `List []) 16 | ; ("[1]", `List [`Num 1]) 17 | ; ("[1 2]", `List [`Num 1; `Num 2]) 18 | ; ("[[]]", `List [`List []]) 19 | ; ("[[1]]", `List [`List [`Num 1]]) 20 | ; ("a", `Id "a") 21 | ; ("test", `Id "test") 22 | ; ("(+ (+ 1 2) 3)", `Op (Plus, [`Op (Plus, [`Num 1; `Num 2]); `Num 3])) 23 | ; ( "(let f (lambda (x) (if (= x 0) 0 (+ (f (- x 1)) 1))) (f 0))" 24 | , `Let 25 | ( "f" 26 | , `Lambda 27 | ( ["x"] 28 | , `Op 29 | ( If 30 | , [ `Op (Eq, [`Id "x"; `Num 0]) 31 | ; `Num 0 32 | ; `Op 33 | ( Plus 34 | , [ `Apply (`Id "f", [`Op (Minus, [`Id "x"; `Num 1])]) 35 | ; `Num 1 ] ) ] ) ) 36 | , `Apply (`Id "f", [`Num 0]) ) ) 37 | ; ("(+ 1 2)", `Op (Plus, [`Num 1; `Num 2])) 38 | ; ("(cons 1 [])", `Op (Cons, [`Num 1; `List []])) 39 | ; ("(cons 1 [2])", `Op (Cons, [`Num 1; `List [`Num 2]])) 40 | ; ("(cdr [])", `Op (Cdr, [`List []])) 41 | ; ("(cdr [1 2])", `Op (Cdr, [`List [`Num 1; `Num 2]])) 42 | ; ("(f 1 2)", `Apply (`Id "f", [`Num 1; `Num 2])) 43 | ; ("(> (f 1 2) 3)", `Op (Gt, [`Apply (`Id "f", [`Num 1; `Num 2]); `Num 3])) 44 | ; ("(map x7 f6)", `Apply (`Id "map", [`Id "x7"; `Id "f6"])) 45 | ; ("{}", `Tree Empty) 46 | ; ("{1}", `Tree (Node (`Num 1, []))) 47 | ; ("{1 {}}", `Tree (Node (`Num 1, [Empty]))) ] 48 | 49 | let test_parse_typ = 50 | make_tests ~in_f:Type.of_string_exn ~out_f:ident ~in_str:ident 51 | ~out_str:Type.to_string ~res_str:Type.to_string "parse_typ" 52 | [("num", Const_t Num_t)] 53 | 54 | let test_parse_example = 55 | make_tests ~in_f:Example.of_string_exn ~out_f:ident ~in_str:ident 56 | ~out_str:Example.to_string ~res_str:Example.to_string "parse_example" 57 | [ ("(f 1) -> 1", (`Apply (`Id "f", [`Num 1]), `Num 1)) 58 | ; ("(f (f 1)) -> 1", (`Apply (`Id "f", [`Apply (`Id "f", [`Num 1])]), `Num 1)) 59 | ; ("(f []) -> []", (`Apply (`Id "f", [`List []]), `List [])) ] 60 | 61 | let tests = 62 | "sexp-parser-tests" >::: [test_parse_expr; test_parse_typ; test_parse_example] 63 | -------------------------------------------------------------------------------- /test/tests.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | open OUnit2 3 | open L2 4 | open Tests_common 5 | open Collections 6 | 7 | let identity (x : 'a) : 'a = x 8 | 9 | let cmp_partition a b = 10 | let sort_partition p = List.sort ~compare:Int.compare p in 11 | let sort_partition_list l = 12 | List.map ~f:sort_partition l |> List.sort ~compare:(List.compare Int.compare) 13 | in 14 | sort_partition_list a = sort_partition_list b 15 | 16 | let m_expr_to_string = function Some e -> Expr.to_string e | None -> "None" 17 | 18 | let test_eval = 19 | let open Eval in 20 | let open Collections.Tree in 21 | make_tests 22 | ~in_f:(fun str -> str |> Expr.of_string_exn |> eval (Ctx.empty ())) 23 | ~out_f:identity ~in_str:identity ~out_str:Value.to_string 24 | ~res_str:Value.to_string "eval" 25 | [ ("1", `Num 1) 26 | ; ("#t", `Bool true) 27 | ; ("#f", `Bool false) 28 | ; ("[1]", `List [`Num 1]) 29 | ; ("(+ 1 2)", `Num 3) 30 | ; ("(- 1 2)", `Num (-1)) 31 | ; ("(* 1 2)", `Num 2) 32 | ; ("(/ 4 2)", `Num 2) 33 | ; ("(% 4 2)", `Num 0) 34 | ; ("(= 4 2)", `Bool false) 35 | ; ("(= 4 4)", `Bool true) 36 | ; ("(> 4 2)", `Bool true) 37 | ; ("(> 4 4)", `Bool false) 38 | ; ("(>= 4 2)", `Bool true) 39 | ; ("(>= 4 4)", `Bool true) 40 | ; ("(>= 4 5)", `Bool false) 41 | ; ("(cons 4 [])", `List [`Num 4]) 42 | ; ("(cons 4 [1])", `List [`Num 4; `Num 1]) 43 | ; ("(car [1])", `Num 1) 44 | ; ("(cdr [1 2])", `List [`Num 2]) 45 | ; ("(if #t 1 2)", `Num 1) 46 | ; ("(if #f 1 2)", `Num 2) 47 | ; ("(let a 1 (+ 1 a))", `Num 2) 48 | ; ("(let a 5 (let b 2 (* a b)))", `Num 10) 49 | ; ("(let a 5 (let a 2 (+ a 1)))", `Num 3) 50 | ; ("(let a (* 3 4) (+ a 1))", `Num 13) 51 | ; ("(let f (lambda (x) (+ 1 x)) (f 1))", `Num 2) 52 | ; ("(let f (lambda (x y) (+ y x)) (f 1 2))", `Num 3) 53 | ; ("(let f (lambda (x) (lambda (y) (+ x y))) ((f 1) 2))", `Num 3) 54 | ; ("(let f (lambda (x) (+ x 1)) (let g (lambda (x) (+ 1 x)) (f (g 1))))", `Num 3) 55 | ; ("(let f (lambda (x) (if (= x 0) 0 (f (- x 1)))) (f 0))", `Num 0) 56 | ; ("(let f (lambda (x) (if (= x 0) 0 (f (- x 1)))) (f 5))", `Num 0) 57 | ; ("(foldr [1 2 3] (lambda (a e) (+ a e)) 0)", `Num 6) 58 | ; (* Sum *) 59 | ( "(foldr [[1] [2 1] [3 2 1]] (lambda (a e) (cons (car e) a)) [])" 60 | , `List [`Num 1; `Num 2; `Num 3] ) 61 | ; (* Firsts *) 62 | ("(foldl [1 2 3] (lambda (a e) (+ a e)) 0)", `Num 6) 63 | ; (* Sum *) 64 | ( "(foldl [[1] [2 1] [3 2 1]] (lambda (a e) (cons (car e) a)) [])" 65 | , `List [`Num 3; `Num 2; `Num 1] ) 66 | ; (* Rev-firsts *) 67 | ("(filter [] (lambda (e) (> 3 e)))", `List []) 68 | ; ("(filter [1 2 3 4] (lambda (e) (> 3 e)))", `List [`Num 1; `Num 2]) 69 | ; ("(filter [1 2 3 4] (lambda (e) (= 0 (% e 2))))", `List [`Num 2; `Num 4]) 70 | ; ("(map [] (lambda (e) (+ e 1)))", `List []) 71 | ; ("(map [1] (lambda (e) (+ e 1)))", `List [`Num 2]) 72 | ; ("(map [1 2] (lambda (e) (+ e 1)))", `List [`Num 2; `Num 3]) 73 | ; ( "(map [0 1 0] (lambda (e) (= e 0)))" 74 | , `List [`Bool true; `Bool false; `Bool true] ) 75 | ; ("{}", `Tree Empty) 76 | ; ("(tree 1 [])", `Tree (Node (`Num 1, []))) 77 | ; ("(tree 1 [(tree 1 [])])", `Tree (Node (`Num 1, [Node (`Num 1, [])]))) 78 | ; ("(value (tree 1 [(tree 1 [])]))", `Num 1) 79 | ; ("(value (tree 1 []))", `Num 1) 80 | ; ("(mapt (tree 1 []) (lambda (e) (+ e 1)))", `Tree (Node (`Num 2, []))) 81 | ; ( "(mapt (tree 1 [(tree 1 [])]) (lambda (e) (+ e 1)))" 82 | , `Tree (Node (`Num 2, [Node (`Num 2, [])])) ) 83 | ; ( "(mapt {1 {1}} (lambda (e) (+ e 1)))" 84 | , `Tree (Node (`Num 2, [Node (`Num 2, [])])) ) 85 | ; ( "(let max (lambda (x) (foldl x (lambda (a e) (if (> e a) e a)) 0)) (max [1 \ 86 | 2 3]))" 87 | , `Num 3 ) 88 | ; ( "(let max (lambda (x) (foldl x (lambda (a e) (if (> e a) e a)) 0)) (max [0 \ 89 | 1 5 9]))" 90 | , `Num 9 ) 91 | ; ( "(let max (lambda (x) (foldl x (lambda (a e) (if (> e a) e a)) 0)) (let \ 92 | dropmax (lambda (y) (filter y (lambda (z) (< z (max y))))) (dropmax [1 5 \ 93 | 0 9])))" 94 | , `List [`Num 1; `Num 5; `Num 0] ) 95 | ; ( "(let member (lambda (l x) (foldl l (lambda (a e ) (| (= e x) a)) #f)) \ 96 | (member [] 0))" 97 | , `Bool false ) 98 | ; ( "(let member (lambda (l x) (foldl l (lambda (a e ) (| (= e x) a)) #f)) \ 99 | (member [0] 0))" 100 | , `Bool true ) 101 | ; ( "(let member (lambda (l x) (foldl l (lambda (a e ) (| (= e x) a)) #f)) \ 102 | (member [0 1 ] 0))" 103 | , `Bool true ) 104 | ; ( "(let count (lambda (l x) (foldl l (lambda (a e) (if (= e x) (+ a 1) a)) \ 105 | 0)) (count [1 2 3 4 4] 4))" 106 | , `Num 2 ) 107 | ; ( "(let last (lambda (a) (foldl a (lambda (c b) b) 0))\n\ 108 | \ (let shiftr (lambda (a) (foldr a (lambda (c b) (foldl c \ 109 | (lambda (e d) (cons (last a) (cons b (cdr c)))) [1])) [])) (shiftr [6 5 3 \ 110 | 7 8])))" 111 | , `List [`Num 8; `Num 6; `Num 5; `Num 3; `Num 7] ) 112 | ; ( "(let last (lambda (a) (foldl a (lambda (c b) b) 0))\n\ 113 | \ (let shiftr (lambda (a) (foldr a (lambda (c b) (foldl c \ 114 | (lambda (e d) (cons (last a) (cons b (cdr c)))) [1])) [])) (shiftr [4 0 \ 115 | 5])))" 116 | , `List [`Num 5; `Num 4; `Num 0] ) ] 117 | 118 | let test_fold_constants = 119 | make_tests 120 | ~in_f:(fun str -> str |> Expr.of_string_exn |> Rewrite.fold_constants) 121 | ~out_f:(fun str -> Some (Expr.of_string_exn str)) 122 | ~in_str:identity ~out_str:identity ~res_str:m_expr_to_string "fold_constants" 123 | [ ("1", "1") 124 | ; ("#f", "#f") 125 | ; ("[]", "[]") 126 | ; ("[1 2]", "[1 2]") 127 | ; ("(+ 1 2)", "3") 128 | ; ("(+ (* 0 5) (/ 4 2))", "2") 129 | ; ("(+ a (- 4 3))", "(+ a 1)") 130 | ; ("(lambda (x) (+ x (* 1 5)))", "(lambda (x) (+ x 5))") 131 | ; ("(lambda (x) (+ 1 (* 1 5)))", "6") ] 132 | 133 | let partition_to_string = List.to_string ~f:(List.to_string ~f:Int.to_string) 134 | 135 | let test_partition = 136 | make_tests ~in_f:Util.partition ~out_f:identity ~in_str:Int.to_string 137 | ~out_str:partition_to_string ~res_str:partition_to_string ~cmp:cmp_partition 138 | "test_partition" 139 | [(0, []); (1, [[1]]); (2, [[2]; [1; 1]]); (3, [[3]; [1; 2]; [1; 1; 1]])] 140 | 141 | let test_m_partition = 142 | "test_m_partition" 143 | >::: List.map 144 | ~f:(fun (n, m, p) -> 145 | let title = 146 | Printf.sprintf "%s -> %s" (Int.to_string n) (partition_to_string p) 147 | in 148 | title 149 | >:: fun _ -> assert_equal ~cmp:cmp_partition (Util.m_partition n m) p ) 150 | [(3, 1, [[3]]); (3, 2, [[1; 2]]); (3, 3, [[1; 1; 1]])] 151 | 152 | let () = 153 | run_test_tt_main 154 | ( "all-tests" 155 | >::: [ (* Eval_tests.tests; *) 156 | Unify_tests.tests 157 | ; Collections_tests.tests 158 | ; Type_tests.tests 159 | ; V2_engine_tests.tests 160 | ; Hypothesis_tests.tests 161 | ; Sexp_parser_tests.tests 162 | ; (* Component_tests.tests; *) 163 | (* Automaton_tests.tests; *) 164 | 165 | (* test_parse_expr; *) 166 | (* test_parse_typ; *) 167 | (* test_parse_example; *) 168 | 169 | (* test_eval; *) 170 | (* test_unify; *) 171 | (* test_signature; *) 172 | 173 | (* test_expand; *) 174 | (* test_expr_to_z3; *) 175 | (* test_verify; *) 176 | test_partition 177 | ; test_m_partition 178 | ; test_fold_constants 179 | (* test_rewrite; *) 180 | (* test_normalize; *) 181 | (* test_denormalize; *) 182 | 183 | (* test_sat_solver; *) 184 | (* test_symb_solver; *) 185 | ] ) 186 | -------------------------------------------------------------------------------- /test/tests_common.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | open OUnit2 3 | 4 | let make_tests ?(cmp = ( = )) ~in_f ~out_f ~in_str ~out_str ~res_str name cases = 5 | name 6 | >::: List.map 7 | ~f:(fun (input, output) -> 8 | let case_name = 9 | Printf.sprintf "%s => %s" (in_str input) (out_str output) 10 | in 11 | case_name 12 | >:: fun _ -> 13 | assert_equal ~printer:res_str ~cmp (out_f output) (in_f input) ) 14 | cases 15 | 16 | let mk_equality_tests ?printer ?cmp name f cases = 17 | name 18 | >::: List.map cases ~f:(fun (input, output) -> 19 | test_case (fun ctxt -> assert_equal ?printer ?cmp ~ctxt output (f input)) 20 | ) 21 | 22 | let assert_equivalent ~sexp expected real = 23 | let to_count_map l = 24 | List.fold l 25 | ~init:(Map.empty (module Sexp)) 26 | ~f:(fun m x -> 27 | Map.change m (sexp x) ~f:(function Some c -> Some (c + 1) | None -> Some 1) 28 | ) 29 | in 30 | let expected_m = to_count_map expected in 31 | let real_m = to_count_map real in 32 | Map.iteri expected_m ~f:(fun ~key:k ~data:v -> 33 | let v' = match Map.find real_m k with Some v' -> v' | None -> 0 in 34 | if v <> v' then 35 | assert_failure 36 | (sprintf "Expected %d instances of %s but got %d." v 37 | (Sexp.to_string_hum k) v') ) ; 38 | Map.iteri real_m ~f:(fun ~key:k ~data:v -> 39 | let v' = match Map.find expected_m k with Some v' -> v' | None -> 0 in 40 | if v <> v' then 41 | assert_failure 42 | (sprintf "Expected %d instances of %s but got %d." v' 43 | (Sexp.to_string_hum k) v) ) 44 | -------------------------------------------------------------------------------- /test/type_tests.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | open OUnit2 3 | open L2 4 | open Tests_common 5 | open Collections 6 | open Infer 7 | 8 | let unifier_of_types_tests = 9 | let open Type in 10 | mk_equality_tests 11 | ~printer:(fun u -> Sexp.to_string_hum (Option.sexp_of_t Unifier.sexp_of_t u)) 12 | ~cmp:(Option.equal Unifier.equal) "unifier-of_types-tests" 13 | (fun (t1, t2) -> Unifier.of_types t1 t2) 14 | [ ((num, num), Some Unifier.empty) 15 | ; ((bool, num), None) 16 | ; ((list (free 0 0), num), None) 17 | ; ((list (free 0 0), num), None) 18 | ; ((list (free 0 0), list num), Some (Unifier.of_alist_exn [(0, num)])) 19 | ; ((list (quant "a"), list num), None) 20 | ; ( (arrow1 (free 0 0) (free 1 0), arrow1 num (free 2 0)) 21 | , Some (Unifier.of_alist_exn [(0, num); (2, free 1 0)]) ) 22 | ; ((tree (free 0 0), tree num), Some (Unifier.of_alist_exn [(0, num)])) 23 | ; ((tree num, tree (free 0 0)), Some (Unifier.of_alist_exn [(0, num)])) 24 | ; ((list (free 0 0), list num), Some (Unifier.of_alist_exn [(0, num)])) 25 | ; ((list num, list (free 0 0)), Some (Unifier.of_alist_exn [(0, num)])) ] 26 | 27 | let unifier_tests = "unifier-tests" >::: [unifier_of_types_tests] 28 | 29 | let infer_typeof_tests = 30 | let cases = 31 | [ ("1", "num") 32 | ; ("#t", "bool") 33 | ; ("#f", "bool") 34 | ; ("[]", "list[a]") 35 | ; ("[1 2 3]", "list[num]") 36 | ; ("(+ 1 2)", "num") 37 | ; ("(< 1 2)", "bool") 38 | ; ("(cons 1 [])", "list[num]") 39 | ; ("(cons 1 [1 2 3])", "list[num]") 40 | ; ("(car [1 2 3])", "num") 41 | ; ("(cdr [1 2 3])", "list[num]") 42 | ; ("(car (cdr [1 2 3]))", "num") 43 | ; ("(let f (lambda (x) (+ 1 x)) f)", "num -> num") 44 | ; ("(let f (lambda (x y) (+ x y)) f)", "(num, num) -> num") 45 | ; ("(let g (lambda (x y f) (+ x (f y))) g)", "(num, a, (a -> num)) -> num") 46 | ; ("(lambda (x y f) (+ x (f y)))", "(num, a, (a -> num)) -> num") 47 | ; ( "(let g (lambda (x y) (lambda (f) (f x y))) g)" 48 | , "(a, b) -> (((a, b) -> c) -> c)" ) 49 | ; ("(let f (lambda (x) (cons x [])) f)", "t1 -> list[t1]") 50 | ; ("(map [] (lambda (x) (+ x 1)))", "list[num]") 51 | ; ("(map [1 2 3] (lambda (x) (+ x 1)))", "list[num]") 52 | ; ("(let f (lambda (x y) (+ x y)) (f 1 2))", "num") 53 | ; ("(let f (lambda (x) (+ x 1)) (f 1))", "num") 54 | ; ("(let f (lambda (x) (+ x 1)) (f 1))", "num") 55 | ; ("(lambda (x) (let y x y))", "t1 -> t1") 56 | ; ("(lambda (x) (let y (lambda (z) z) y))", "t0 -> (t1 -> t1)") 57 | ; ("(let f (lambda (x) x) (let id (lambda (y) y) (= f id)))", "bool") 58 | ; ("(let apply (lambda (f x) (f x)) apply)", "((a -> b), a) -> b") 59 | ; ( "(lambda (f) (let x (lambda (g y) (let z (g y) (= f g))) x))" 60 | , "(a -> b) -> (((a -> b), a) -> bool)" ) 61 | ; ( "(lambda (f) (let x (lambda (g) (let z (g 1) (= f g))) x))" 62 | , "(num -> b) -> ((num -> b) -> bool)" ) 63 | ; ( "(lambda (f) (lambda (g) (let z (g 1) (= f g))))" 64 | , "(num -> b) -> ((num -> b) -> bool)" ) 65 | ; ("(lambda (f) (let x (lambda (g) (= f g)) x))", "a -> (a -> bool)") 66 | ; ("(lambda (f g) (let z (g 1) (= f g)))", "((num -> a), (num -> a)) -> bool") 67 | ; ("(lambda (l x) (= [x] l))", "(list[a], a) -> bool") 68 | ; ("(let a 0 (let b 1 (lambda (x) (cons a [b]))))", "a -> list[num]") 69 | ; ("(lambda (y) (if (= 0 y) 0 1))", "num -> num") 70 | ; ("(lambda (y) (= y 1))", "num -> bool") 71 | ; ("{}", "tree[a]") 72 | ; ("{1}", "tree[num]") 73 | ; ("{1 {2}}", "tree[num]") 74 | ; ("(value {1})", "num") 75 | ; ("(children {1 {2} {3}})", "list[tree[num]]") ] 76 | |> List.map ~f:(fun (input_s, output_s) -> 77 | (Expr.of_string_exn input_s, Type.normalize (Type.of_string_exn output_s)) 78 | ) 79 | in 80 | mk_equality_tests 81 | ~printer:(fun t -> Sexp.to_string (Type.sexp_of_t t)) 82 | ~cmp:Type.equal "infer-typeof-tests" 83 | (fun input -> 84 | let t, _ = Type.of_expr input in 85 | t ) 86 | cases 87 | 88 | let infer_tests = "infer-tests" >::: [ (* infer_typeof_tests; *) ] 89 | 90 | let tests = "type-tests" >::: [unifier_tests; infer_tests] 91 | -------------------------------------------------------------------------------- /test/unify_tests.ml: -------------------------------------------------------------------------------- 1 | open OUnit2 2 | open L2 3 | open Unify 4 | 5 | let test_unify_apply = 6 | "test-unify-apply" 7 | >:: fun _ -> 8 | let ev = `Apply (`Id "sum", [`Id "x"]) in 9 | let st2 = K "1" in 10 | match sterm_of_expr_value ev with 11 | | Some st1 -> 12 | let t1, t2 = (translate st1, translate st2) in 13 | assert_equal ~printer:sub_to_string 14 | [("(sum x)", Term ("1", []))] 15 | (unify_one t1 t2) 16 | | None -> assert_failure "Creating term failed." 17 | 18 | let tests = "unify-tests" >::: [test_unify_apply] 19 | -------------------------------------------------------------------------------- /test/v2_engine_tests.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | open OUnit2 3 | open L2 4 | open Synthesis_common 5 | open Hypothesis 6 | open V2_engine 7 | module Sym = L2_Generalizer.Symbols 8 | module Gen = L2_Generalizer.With_components 9 | module Mem = Memoizer 10 | 11 | let cost_model = default_cost_model 12 | 13 | let top = Specification.top 14 | 15 | let cost_model_tests = 16 | "cost-model" 17 | >::: [ test_case (fun ctxt -> 18 | let h = 19 | let cm = cost_model in 20 | let one = Hypothesis.num cm 1 top in 21 | Hypothesis.apply cm 22 | (Hypothesis.id_name cm "append" top) 23 | [one; one] top 24 | in 25 | assert_equal ~ctxt ~printer:Int.to_string 3 (Hypothesis.cost h) ) ] 26 | 27 | (* let memoizer_tests = "memoizer" >::: [ *) 28 | (* "get" >::: [ *) 29 | (* test_case (fun _ -> *) 30 | (* let m = create_memoizer () in *) 31 | (* let hole = Hole.create Type.num Sym.constant in *) 32 | (* assert_raises ~msg:"Out of bounds cost should raise Invalid_argument." *) 33 | (* (Invalid_argument "Argument out of range.") (fun () -> *) 34 | (* Mem.get m hole Specification.Top (-1)) *) 35 | (* ); *) 36 | 37 | (* test_case (fun _ -> *) 38 | (* let m = create_memoizer () in *) 39 | (* let hole = Hole.create Type.num Sym.constant in *) 40 | (* assert_equal [] (Mem.get m hole Specification.Top 0) *) 41 | (* ); *) 42 | 43 | (* test_case (fun _ -> *) 44 | (* let m = create_memoizer () in *) 45 | (* let hole = Hole.create Type.num Sym.constant in *) 46 | (* let spec = Specification.Top in *) 47 | (* assert_equivalent ~sexp:(Tuple.T2.sexp_of_t Hypothesis.sexp_of_t Unifier.sexp_of_t) *) 48 | (* (Gen.generate_constants hole spec) *) 49 | (* (Mem.get m hole spec 1) *) 50 | (* ); *) 51 | 52 | (* test_case (fun ctxt -> *) 53 | (* let m = create_memoizer () in *) 54 | (* let hole = Hole.create Type.num Sym.expression in *) 55 | (* let spec = Specification.Top in *) 56 | (* assert_equal ~ctxt ~cmp:Int.equal ~printer:Int.to_string *) 57 | (* 52 (List.length (Mem.get m hole spec 3)) *) 58 | (* ); *) 59 | 60 | (* test_case (fun ctxt -> *) 61 | (* let m = create_memoizer () in *) 62 | (* let hole = Hole.create (Type.list (Type.free 0 0)) Sym.expression in *) 63 | (* let spec = Specification.Top in *) 64 | (* assert_equal ~ctxt ~cmp:Int.equal ~printer:Int.to_string *) 65 | (* 63 (List.length (Mem.get m hole spec 3)) *) 66 | (* ); *) 67 | (* ] *) 68 | (* ] *) 69 | 70 | let tests = 71 | "v2-engine" 72 | >::: [ cost_model_tests 73 | ; "symbol" 74 | >::: [ "create" 75 | >::: [ test_case (fun _ -> 76 | let s1 = Symbol.create "test1" in 77 | let s2 = Symbol.create "test2" in 78 | assert_bool "A symbol is only equal to itself." 79 | (not (Symbol.equal s1 s2)) ) 80 | ; test_case (fun _ -> 81 | let s1 = Symbol.create "test" in 82 | let s2 = Symbol.create "test" in 83 | assert_bool "A symbol is only equal to itself." 84 | (not (Symbol.equal s1 s2)) ) 85 | ; test_case (fun _ -> 86 | let s = Symbol.create "test" in 87 | assert_bool "A symbol is only equal to itself." 88 | (Symbol.equal s s) ) ] ] 89 | (* memoizer_tests; *) 90 | ] 91 | --------------------------------------------------------------------------------