From 18fa9ac1ded14e8e6b96609ff1fb6f98af47580f Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 8 Sep 2017 19:20:46 -0400 Subject: - Removed the (non) tests for case synthesis. --- new-luxc/test/test/luxc/synthesizer/case.lux | 213 --------------------------- new-luxc/test/tests.lux | 4 +- 2 files changed, 1 insertion(+), 216 deletions(-) delete mode 100644 new-luxc/test/test/luxc/synthesizer/case.lux (limited to 'new-luxc') diff --git a/new-luxc/test/test/luxc/synthesizer/case.lux b/new-luxc/test/test/luxc/synthesizer/case.lux deleted file mode 100644 index ff60deedb..000000000 --- a/new-luxc/test/test/luxc/synthesizer/case.lux +++ /dev/null @@ -1,213 +0,0 @@ -(;module: - lux - (lux [io] - (control [monad #+ do] - pipe - eq) - (data [bool "B/" Eq] - [text "T/" Eq] - [product] - [number] - text/format - (coll [list "L/" Functor Fold Monoid] - ["s" set])) - ["r" math/random "r/" Monad] - test) - (luxc (lang ["la" analysis] - ["ls" synthesis]) - [synthesizer] - (synthesizer ["@" case])) - (.. common)) - -(struct: _ (Eq ls;Synthesis) - (def: (= reference sample) - (case [reference sample] - (^template [ ] - [( reference') ( sample')] - ( reference' sample')) - ([#ls;Unit is] - [#ls;Bool B/=] - [#ls;Nat n.=] - [#ls;Int i.=] - [#ls;Deg d.=] - [#ls;Frac f.=] - [#ls;Text T/=]) - - _ - false))) - -(struct: _ (Eq ls;Path) - (def: (= reference sample) - (case [reference sample] - (^or [#ls;UnitP #ls;UnitP] - [(#ls;ExecP _) (#ls;ExecP _)]) - true - - (^template [ ] - [( reference') ( sample')] - ( reference' sample')) - ([#ls;BindP n.=] - [#ls;BoolP B/=] - [#ls;NatP n.=] - [#ls;IntP i.=] - [#ls;DegP d.=] - [#ls;FracP f.=] - [#ls;TextP T/=]) - - (^template [ ] - [( ( reference') reference-then) - ( ( sample') sample-then)] - (and (n.= reference' sample') - (= reference-then sample-then))) - ([#ls;VariantP #;Left] - [#ls;VariantP #;Right] - [#ls;TupleP #;Left] - [#ls;TupleP #;Right]) - - (^template [] - [( referenceL referenceR) ( sampleL sampleR)] - (and (= referenceL sampleL) - (= referenceR sampleR))) - ([#ls;AltP] - [#ls;SeqP]) - - _ - false))) - -(do-template [ ] - [(def: - (r;Random ls;Path) - (do r;Monad - [num-alts (|> r;nat (:: @ map (|>. (n.% ) (n.max +1)))) - samples (|> (r;set num-alts ) - (:: @ map s;to-list))] - (case (|> samples - (L/map (|>. )) - list;reverse) - (#;Cons last prevs) - (wrap (L/fold (function [left right] - (#ls;AltP left right)) - last - prevs)) - - #;Nil - (undefined))))] - - [gen-bool #ls;BoolP r;bool bool;Hash +2] - [gen-nat #ls;NatP r;nat number;Hash +5] - [gen-int #ls;IntP r;int number;Hash +5] - [gen-deg #ls;DegP r;deg number;Hash +5] - [gen-frac #ls;FracP r;frac number;Hash +5] - [gen-text #ls;TextP (r;text +5) text;Hash +5] - ) - -(def: gen-primitive-path - (r;Random ls;Path) - (r;either (r;either (r;either (r/wrap #ls;UnitP) - gen-bool) - (r;either gen-nat - gen-int)) - (r;either (r;either gen-deg - gen-frac) - gen-text))) - -(do-template [ ] - [(def: ( gen-path) - (-> (-> (Maybe ls;Synthesis) (r;Random ls;Path)) - (r;Random ls;Path)) - (do r;Monad - [size (|> r;nat (:: @ map (|>. (n.% +10) (n.max +2)))) - members (r;list size (gen-path #;None))] - (case (list;reverse (list;enumerate members)) - (#;Cons [last-idx last-path] prevs) - (wrap (L/fold (function [[left-idx left-path] right-path] - ( ( (#;Right left-idx) left-path) - right-path)) - ( (#;Right last-idx) last-path) - prevs)) - - #;Nil - (undefined))))] - - [gen-tuple-path #ls;TupleP #ls;SeqP] - [gen-variant-path #ls;VariantP #ls;AltP] - ) - -(def: (gen-path ?body) - (-> (Maybe ls;Synthesis) (r;Random ls;Path)) - (do r;Monad - [pattern (r;either (r;either (r/wrap (#ls;BindP +0)) - gen-primitive-path) - (r;either (gen-tuple-path gen-path) - (gen-variant-path gen-path)))] - (case ?body - #;None - (wrap pattern) - - (#;Some body) - (wrap (#ls;SeqP pattern (#ls;ExecP body)))))) - -(def: (to-branches path) - (-> ls;Path (List la;Pattern)) - (case path - (^template [ ] - ( value) - (list ( value))) - ([#ls;UnitP #la;UnitP] - [#ls;BoolP #la;BoolP] - [#ls;NatP #la;NatP] - [#ls;IntP #la;IntP] - [#ls;DegP #la;DegP] - [#ls;FracP #la;FracP] - [#ls;TextP #la;TextP] - [#ls;BindP #la;BindP]) - - (#ls;AltP left right) - (L/append (to-branches left) - (to-branches right)) - - (#ls;SeqP (#ls;TupleP (#;Left +0) head) - tail) - (loop [head head - tail tail] - (case [(path-to-pattern head) tail] - [(#;Some =head) (#ls;SeqP (#ls;TupleP (#;Left idx) head') - tail')] - (list& =head (recur head' tail')) - - [(#;Some =head) (#ls;SeqP (#ls;TupleP (#;Left idx) head') - tail')] - (list& =head (recur head' tail')) - - [(#;Some =head) (#ls;SeqP (#ls;TupleP (#;Right last-idx)) - tail')] - (do list;Monad - [=tail' (to-branches tail') - =right (to-branches right)] - ))) - - (#ls;SeqP left right) - (do list;Monad - [=left (to-branches left) - =right (to-branches right)] - ) - - #PopP - (#VariantP (Either Nat Nat)) - (#TupleP (Either Nat Nat)) - - - (#ExecP s) - )) - -(context: "Pattern-matching." - [outputA gen-primitive - prediction (gen-path (#;Some (synthesizer;synthesize outputA))) - #let [branches (to-branches outputA prediction)]] - (test "Can efficiently synthesize pattern-matching trees." - (|> (synthesizer;synthesize (#la;Case #la;Unit branches)) - (case> (#la;Case #ls;Unit pathS) - (:: Eq prediction pathS) - - _ - false)))) diff --git a/new-luxc/test/tests.lux b/new-luxc/test/tests.lux index 695c72174..06f3e940e 100644 --- a/new-luxc/test/tests.lux +++ b/new-luxc/test/tests.lux @@ -14,7 +14,6 @@ (procedure ["_;A" common])) (synthesizer ["_;S" primitive] ["_;S" structure] - ## ["_;S" case] (case ["_;S" special]) ["_;S" function] ["_;S" procedure] @@ -23,8 +22,7 @@ ["_;G" structure] (procedure ["_;G" common])) )) - ## (luxc (generator ["_;G" function]) - ## ) + ## (luxc (generator ["_;G" function])) ) ## [Program] -- cgit v1.2.3