diff options
Diffstat (limited to '')
| -rw-r--r-- | lux-jvm/test/test/luxc/lang/synthesis/loop.lux | 162 |
1 files changed, 0 insertions, 162 deletions
diff --git a/lux-jvm/test/test/luxc/lang/synthesis/loop.lux b/lux-jvm/test/test/luxc/lang/synthesis/loop.lux deleted file mode 100644 index 51e4f3ace..000000000 --- a/lux-jvm/test/test/luxc/lang/synthesis/loop.lux +++ /dev/null @@ -1,162 +0,0 @@ -(.using - lux - (lux [io] - (control [monad {"+" do}]) - (data [bit "bit/" Eq<Bit>] - [number] - (coll [list "list/" Functor<List>] - (set ["set" unordered])) - text/format) - (macro [code]) - ["r" math/random "r/" Monad<Random>] - test) - (luxc (lang ["la" analysis] - ["ls" synthesis] - (synthesis ["[0]S" expression] - ["[0]S" loop]) - ["[0]L" extension])) - (// common)) - -(def: (does-recursion? arity exprS) - (-> ls.Arity ls.Synthesis Bit) - (loop [exprS exprS] - (case exprS - (^ [_ {.#Form (list [_ {.#Text "lux case"}] inputS pathS)}]) - (loop [pathS pathS] - (case pathS - (^ [_ {.#Form (list [_ {.#Text "lux case alt"}] leftS rightS)}]) - (or (again leftS) - (again rightS)) - - (^ [_ {.#Form (list [_ {.#Text "lux case seq"}] leftS rightS)}]) - (again rightS) - - (^ [_ {.#Form (list [_ {.#Text "lux case exec"}] bodyS)}]) - (does-recursion? arity bodyS) - - _ - #0)) - - (^ [_ {.#Form (list& [_ {.#Text "lux again"}] argsS)}]) - (n/= arity (list.size argsS)) - - (^ [_ {.#Form (list [_ {.#Text "lux let"}] register inputS bodyS)}]) - (again bodyS) - - (^ [_ {.#Form (list [_ {.#Text "lux if"}] inputS thenS elseS)}]) - (or (again thenS) - (again elseS)) - - _ - #0 - ))) - -(def: (gen-body arity output) - (-> Nat la.Analysis (r.Random la.Analysis)) - (r.either (r.either (r/wrap output) - (do r.Monad<Random> - [inputA (|> r.nat (:: @ each code.nat)) - num-cases (|> r.nat (:: @ each (|>> (n/% +10) (n/max +1)))) - tests (|> (r.set number.Hash<Nat> num-cases r.nat) - (:: @ each (|>> set.to-list (list/each code.nat)))) - #let [bad-bodies (list.repeat num-cases (' []))] - good-body (gen-body arity output) - where-to-set (|> r.nat (:: @ each (n/% num-cases))) - #let [bodies (list.together (list (list.first where-to-set bad-bodies) - (list good-body) - (list.after (n/++ where-to-set) bad-bodies)))]] - (wrap (` ("lux case" (~ inputA) - (~ (code.record (list.zip2 tests bodies)))))))) - (r.either (do r.Monad<Random> - [valueS r.bit - output' (gen-body (n/++ arity) output)] - (wrap (` ("lux case" (~ (code.bit valueS)) - {("lux case bind" (~ (code.nat arity))) (~ output')})))) - (do r.Monad<Random> - [valueS r.bit - then|else r.bit - output' (gen-body arity output) - #let [thenA (if then|else output' (' [])) - elseA (if (not then|else) output' (' []))]] - (wrap (` ("lux case" (~ (code.bit valueS)) - {(~ (code.bit then|else)) (~ thenA) - (~ (code.bit (not then|else))) (~ elseA)}))))) - )) - -(def: (make-function arity body) - (-> ls.Arity la.Analysis la.Analysis) - (case arity - +0 body - _ (` ("lux function" [] (~ (make-function (n/-- arity) body)))))) - -(def: gen-recursion - (r.Random [Bit Nat la.Analysis]) - (do r.Monad<Random> - [arity (|> r.nat (:: @ each (|>> (n/% +10) (n/max +1)))) - again? r.bit - outputS (if again? - (wrap (la.apply (list.repeat arity (' [])) (la.var 0))) - (do @ - [plus-or-minus? r.bit - how-much (|> r.nat (:: @ each (|>> (n/% arity) (n/max +1)))) - #let [shift (if plus-or-minus? n/+ n/-)]] - (wrap (la.apply (list.repeat (shift how-much arity) (' [])) (la.var 0))))) - bodyS (gen-body arity outputS)] - (wrap [again? arity (make-function arity bodyS)]))) - -(def: gen-loop - (r.Random [Bit Nat la.Analysis]) - (do r.Monad<Random> - [arity (|> r.nat (:: @ each (|>> (n/% +10) (n/max +1)))) - again? r.bit - self-ref? r.bit - #let [selfA (la.var 0) - argA (if self-ref? selfA (' []))] - outputS (if again? - (wrap (la.apply (list.repeat arity argA) selfA)) - (do @ - [plus-or-minus? r.bit - how-much (|> r.nat (:: @ each (|>> (n/% arity) (n/max +1)))) - #let [shift (if plus-or-minus? n/+ n/-)]] - (wrap (la.apply (list.repeat (shift how-much arity) (' [])) selfA)))) - bodyS (gen-body arity outputS)] - (wrap [(and again? (not self-ref?)) - arity - (make-function arity bodyS)]))) - -(context: "Recursion." - (<| (times +100) - (do @ - [[prediction arity analysis] gen-recursion] - ($_ seq - (test "Can accurately identify (and then reify) tail recursion." - (case (expressionS.synthesize extensionL.no-syntheses - analysis) - (^ [_ {.#Form (list [_ {.#Text "lux function"}] [_ {.#Nat _arity}] [_ {.#Tuple _env}] _body)}]) - (|> _body - (does-recursion? arity) - (bit/= prediction) - (and (n/= arity _arity))) - - _ - #0)))))) - -(context: "Loop." - (<| (times +100) - (do @ - [[prediction arity analysis] gen-recursion] - ($_ seq - (test "Can reify loops." - (case (expressionS.synthesize extensionL.no-syntheses - (la.apply (list.repeat arity (' [])) analysis)) - (^ [_ {.#Form (list [_ {.#Text "lux loop"}] [_ {.#Nat in_register}] [_ {.#Tuple _inits}] _body)}]) - (and (n/= arity (list.size _inits)) - (not (loopS.contains-self-reference? _body))) - - (^ [_ {.#Form (list& [_ {.#Text "lux call"}] - [_ {.#Form (list [_ {.#Text "lux function"}] _arity _env _bodyS)}] - argsS)}]) - (loopS.contains-self-reference? _bodyS) - - _ - #0)))))) |