From cbb916354e5fae89b659fcb4699650e0dad7aa25 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 14 Jun 2018 18:28:30 -0400 Subject: - Migrated synthesis to stdlib. --- stdlib/test/test/lux/lang/analysis/reference.lux | 4 +- stdlib/test/test/lux/lang/synthesis/case.lux | 89 +++++++++++++----------- stdlib/test/test/lux/lang/synthesis/function.lux | 37 +++++----- 3 files changed, 67 insertions(+), 63 deletions(-) (limited to 'stdlib/test') diff --git a/stdlib/test/test/lux/lang/analysis/reference.lux b/stdlib/test/test/lux/lang/analysis/reference.lux index 00689f3e0..e67756d55 100644 --- a/stdlib/test/test/lux/lang/analysis/reference.lux +++ b/stdlib/test/test/lux/lang/analysis/reference.lux @@ -36,7 +36,7 @@ (typeA.with-inference (..analyse (code.symbol ["" var-name]))))) (macro.run (initL.compiler [])) - (case> (^ (#e.Success [inferredT (#analysisL.Variable (#analysisL.Local var))])) + (case> (^ (#e.Success [inferredT (analysisL.variable/local var)])) (and (type/= expectedT inferredT) (n/= +0 var)) @@ -49,7 +49,7 @@ (..analyse (code.symbol def-name)))) (moduleL.with-module +0 module-name) (macro.run (initL.compiler [])) - (case> (#e.Success [_ inferredT (#analysisL.Constant constant-name)]) + (case> (^ (#e.Success [_ inferredT (analysisL.reference/constant constant-name)])) (and (type/= expectedT inferredT) (ident/= def-name constant-name)) diff --git a/stdlib/test/test/lux/lang/synthesis/case.lux b/stdlib/test/test/lux/lang/synthesis/case.lux index 3ae62badc..23ed6726c 100644 --- a/stdlib/test/test/lux/lang/synthesis/case.lux +++ b/stdlib/test/test/lux/lang/synthesis/case.lux @@ -1,47 +1,50 @@ (.module: lux - (lux [io] - (control [monad #+ do] + (lux (control [monad #+ do] pipe) - (macro [code]) + (data [error "error/" Functor]) + (lang [".L" analysis #+ Branch Analysis] + ["//" synthesis #+ Synthesis] + (synthesis [".S" expression]) + [".L" extension]) ["r" math/random "r/" Monad] test) - (luxc (lang ["la" analysis] - ["//" synthesis #+ Synthesis] - (synthesis [".S" expression]) - [".L" extension] - [".L" variable #+ Variable])) - (/// common)) + [//primitive]) (context: "Dummy variables." (<| (times +100) (do @ - [maskedA gen-primitive + [maskedA //primitive.primitive temp (|> r.nat (:: @ map (n/% +100))) - #let [maskA (` ("lux case" (~ maskedA) - {("lux case bind" (~ (code.nat temp))) - (~ (la.var (variableL.local temp)))}))]] + #let [maskA (analysisL.control/case + [maskedA + [[(#analysisL.Bind temp) + (analysisL.variable/local temp)] + (list)]])]] (test "Dummy variables created to mask expressions get eliminated during synthesis." - (|> (//.run (expressionS.synthesizer extensionL.no-syntheses - maskA)) - (corresponds? maskedA)))))) + (|> maskA + (//.run (expressionS.synthesizer extensionL.empty)) + (error/map (//primitive.corresponds? maskedA)) + (error.default false)))))) (context: "Let expressions." (<| (times +100) (do @ [registerA r.nat - inputA gen-primitive - outputA gen-primitive - #let [letA (` ("lux case" (~ inputA) - {("lux case bind" (~ (code.nat registerA))) - (~ outputA)}))]] + inputA //primitive.primitive + outputA //primitive.primitive + #let [letA (analysisL.control/case + [inputA + [[(#analysisL.Bind registerA) + outputA] + (list)]])]] (test "Can detect and reify simple 'let' expressions." - (|> (//.run (expressionS.synthesizer extensionL.no-syntheses - letA)) - (case> (^ [_ (#.Form (list [_ (#.Text "lux let")] [_ (#.Nat registerS)] inputS outputS))]) + (|> letA + (//.run (expressionS.synthesizer extensionL.empty)) + (case> (^ (#error.Success (//.branch/let [inputS registerS outputS]))) (and (n/= registerA registerS) - (corresponds? inputA inputS) - (corresponds? outputA outputS)) + (//primitive.corresponds? inputA inputS) + (//primitive.corresponds? outputA outputS)) _ false)))))) @@ -50,23 +53,25 @@ (<| (times +100) (do @ [then|else r.bool - inputA gen-primitive - thenA gen-primitive - elseA gen-primitive - #let [ifA (if then|else - (` ("lux case" (~ inputA) - {true (~ thenA) - false (~ elseA)})) - (` ("lux case" (~ inputA) - {false (~ elseA) - true (~ thenA)})))]] + inputA //primitive.primitive + thenA //primitive.primitive + elseA //primitive.primitive + #let [thenB (: Branch + [(#analysisL.Simple (#analysisL.Bool true)) + thenA]) + elseB (: Branch + [(#analysisL.Simple (#analysisL.Bool false)) + elseA]) + ifA (if then|else + (analysisL.control/case [inputA [thenB (list elseB)]]) + (analysisL.control/case [inputA [elseB (list thenB)]]))]] (test "Can detect and reify simple 'if' expressions." - (|> (//.run (expressionS.synthesizer extensionL.no-syntheses - ifA)) - (case> (^ [_ (#.Form (list [_ (#.Text "lux if")] inputS thenS elseS))]) - (and (corresponds? inputA inputS) - (corresponds? thenA thenS) - (corresponds? elseA elseS)) + (|> ifA + (//.run (expressionS.synthesizer extensionL.empty)) + (case> (^ (#error.Success (//.branch/if [inputS thenS elseS]))) + (and (//primitive.corresponds? inputA inputS) + (//primitive.corresponds? thenA thenS) + (//primitive.corresponds? elseA elseS)) _ false)))))) diff --git a/stdlib/test/test/lux/lang/synthesis/function.lux b/stdlib/test/test/lux/lang/synthesis/function.lux index c469d8665..93ca5d40d 100644 --- a/stdlib/test/test/lux/lang/synthesis/function.lux +++ b/stdlib/test/test/lux/lang/synthesis/function.lux @@ -11,7 +11,7 @@ (coll [list "list/" Functor Fold] (dictionary ["dict" unordered #+ Dict]) (set ["set" unordered]))) - (lang [".L" analysis #+ Variable Analysis "variable/" Eq] + (lang [".L" analysis #+ Variable Analysis "variable/" Equality] ["//" synthesis #+ Arity Synthesis] (synthesis [".S" expression]) [".L" extension]) @@ -44,40 +44,39 @@ (do r.Monad [num-locals (|> r.nat (:: @ map (|>> (n/% +100) (n/max +10)))) #let [indices (list.n/range +0 (dec num-locals)) - absolute-env (list/map (|>> #analysisL.Local) indices) - relative-env (list/map (|>> #analysisL.Foreign) indices)] + local-env (list/map (|>> #analysisL.Local) indices) + foreign-env (list/map (|>> #analysisL.Foreign) indices)] [arity bodyA predictionA] (: (r.Random [Arity Analysis Variable]) (loop [arity +1 - global-env relative-env] - (let [env-size (list.size global-env) + current-env foreign-env] + (let [current-env/size (list.size current-env) resolver (list/fold (function (_ [idx var] resolver) (dict.put idx var resolver)) (: (Dict Nat Variable) (dict.new number.Hash)) - (list.zip2 (list.n/range +0 (dec env-size)) - global-env))] + (list.enumerate current-env))] (do @ [nest? r.bool] (if nest? (do @ - [num-picks (:: @ map (n/max +1) (pick (inc env-size))) - picks (|> (r.set number.Hash num-picks (pick env-size)) + [num-picks (:: @ map (n/max +1) (pick (inc current-env/size))) + picks (|> (r.set number.Hash num-picks (pick current-env/size)) (:: @ map set.to-list)) [arity bodyA predictionA] (recur (inc arity) (list/map (function (_ pick) - (maybe.assume (list.nth pick global-env))) - picks))] + (maybe.assume (list.nth pick current-env))) + picks)) + #let [picked-env (list/map (|>> #analysisL.Foreign) picks)]] (wrap [arity - (#analysisL.Function (list/map (|>> #analysisL.Foreign) picks) - bodyA) + (#analysisL.Function picked-env bodyA) predictionA])) (do @ - [chosen (pick (list.size global-env))] + [chosen (pick (list.size current-env))] (wrap [arity - (#analysisL.Variable (#analysisL.Foreign chosen)) + (analysisL.variable/foreign chosen) (maybe.assume (dict.get chosen resolver))])))))))] (wrap [arity - (#analysisL.Function absolute-env bodyA) + (#analysisL.Function local-env bodyA) predictionA]))) (def: local-function @@ -94,7 +93,7 @@ (do r.Monad [chosen (|> r.nat (:: @ map (|>> (n/% +100) (n/max +2))))] (wrap [arity - (#analysisL.Variable (#analysisL.Local chosen)) + (analysisL.variable/local chosen) (|> chosen (n/+ (dec arity)) #analysisL.Local)]))))) (context: "Function definition." @@ -116,7 +115,7 @@ (test "Folded functions provide direct access to environment variables." (|> function//environment (//.run (expressionS.synthesizer extensionL.empty)) - (case> (^ (#error.Success (//.function/abstraction [environment arity (#//.Variable output)]))) + (case> (^ (#error.Success (//.function/abstraction [environment arity (analysisL.reference/variable output)]))) (and (n/= arity//environment arity) (variable/= prediction//environment output)) @@ -125,7 +124,7 @@ (test "Folded functions properly offset local variables." (|> function//local (//.run (expressionS.synthesizer extensionL.empty)) - (case> (^ (#error.Success (//.function/abstraction [environment arity (#//.Variable output)]))) + (case> (^ (#error.Success (//.function/abstraction [environment arity (analysisL.reference/variable output)]))) (and (n/= arity//local arity) (variable/= prediction//local output)) -- cgit v1.2.3