From c99909d6f03d9968cdd81c8a5c7e254372a3afcd Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 16 Jul 2018 22:30:29 -0400 Subject: - Fixed synthesis code. --- .../test/lux/language/compiler/synthesis/case.lux | 41 ++++++++------- .../lux/language/compiler/synthesis/function.lux | 59 +++++++++++---------- .../lux/language/compiler/synthesis/primitive.lux | 61 +++++++++++----------- .../lux/language/compiler/synthesis/structure.lux | 21 ++++---- 4 files changed, 93 insertions(+), 89 deletions(-) (limited to 'stdlib/test') diff --git a/stdlib/test/test/lux/language/compiler/synthesis/case.lux b/stdlib/test/test/lux/language/compiler/synthesis/case.lux index 0f907f310..da8e59fa1 100644 --- a/stdlib/test/test/lux/language/compiler/synthesis/case.lux +++ b/stdlib/test/test/lux/language/compiler/synthesis/case.lux @@ -6,12 +6,13 @@ [data [error ("error/" Functor)]] [language - ["///." reference] - ["///." compiler - [".L" analysis (#+ Branch Analysis)] + [reference] + ["." compiler + [analysis (#+ Branch Analysis)] ["//" synthesis (#+ Synthesis) - [".S" expression]] - [".L" extension]]] + [expression]] + [extension + [bundle]]]] [math ["r" random]] test] @@ -22,15 +23,15 @@ (do @ [maskedA //primitive.primitive temp (|> r.nat (:: @ map (n/% +100))) - #let [maskA (analysisL.control/case + #let [maskA (analysis.control/case [maskedA - [[(#analysisL.Bind temp) - (#analysisL.Reference (///reference.local temp))] + [[(#analysis.Bind temp) + (#analysis.Reference (reference.local temp))] (list)]])]] (test "Dummy variables created to mask expressions get eliminated during synthesis." (|> maskA - (expressionS.synthesizer extensionL.empty) - (///compiler.run //.init) + expression.synthesize + (compiler.run [bundle.empty //.init]) (error/map (//primitive.corresponds? maskedA)) (error.default #0)))))) @@ -40,15 +41,15 @@ [registerA r.nat inputA //primitive.primitive outputA //primitive.primitive - #let [letA (analysisL.control/case + #let [letA (analysis.control/case [inputA - [[(#analysisL.Bind registerA) + [[(#analysis.Bind registerA) outputA] (list)]])]] (test "Can detect and reify simple 'let' expressions." (|> letA - (expressionS.synthesizer extensionL.empty) - (///compiler.run //.init) + expression.synthesize + (compiler.run [bundle.empty //.init]) (case> (^ (#error.Success (//.branch/let [inputS registerS outputS]))) (and (n/= registerA registerS) (//primitive.corresponds? inputA inputS) @@ -65,18 +66,18 @@ thenA //primitive.primitive elseA //primitive.primitive #let [thenB (: Branch - [(#analysisL.Simple (#analysisL.Bit #1)) + [(#analysis.Simple (#analysis.Bit #1)) thenA]) elseB (: Branch - [(#analysisL.Simple (#analysisL.Bit #0)) + [(#analysis.Simple (#analysis.Bit #0)) elseA]) ifA (if then|else - (analysisL.control/case [inputA [thenB (list elseB)]]) - (analysisL.control/case [inputA [elseB (list thenB)]]))]] + (analysis.control/case [inputA [thenB (list elseB)]]) + (analysis.control/case [inputA [elseB (list thenB)]]))]] (test "Can detect and reify simple 'if' expressions." (|> ifA - (expressionS.synthesizer extensionL.empty) - (///compiler.run //.init) + expression.synthesize + (compiler.run [bundle.empty //.init]) (case> (^ (#error.Success (//.branch/if [inputS thenS elseS]))) (and (//primitive.corresponds? inputA inputS) (//primitive.corresponds? thenA thenS) diff --git a/stdlib/test/test/lux/language/compiler/synthesis/function.lux b/stdlib/test/test/lux/language/compiler/synthesis/function.lux index 0c55b64fd..8954aafb1 100644 --- a/stdlib/test/test/lux/language/compiler/synthesis/function.lux +++ b/stdlib/test/test/lux/language/compiler/synthesis/function.lux @@ -15,12 +15,13 @@ ["dict" dictionary (#+ Dictionary)] [set]]] [language - ["///." reference (#+ Variable) ("variable/" Equivalence)] - ["///." compiler - [".L" analysis (#+ Arity Analysis)] + [reference (#+ Variable) ("variable/" Equivalence)] + ["." compiler + [analysis (#+ Arity Analysis)] ["//" synthesis (#+ Synthesis) - [".S" expression]] - [".L" extension]]] + [expression]] + [extension + [bundle]]]] [math ["r" random]] test] [//primitive]) @@ -35,7 +36,7 @@ (do @ [[arity bodyA predictionA] constant-function] (wrap [(inc arity) - (#analysisL.Function (list) bodyA) + (#analysis.Function (list) bodyA) predictionA])) (do @ [predictionA //primitive.primitive] @@ -50,8 +51,8 @@ (do r.Monad [num-locals (|> r.nat (:: @ map (|>> (n/% +100) (n/max +10)))) #let [indices (list.n/range +0 (dec num-locals)) - local-env (list/map (|>> #///reference.Local) indices) - foreign-env (list/map (|>> #///reference.Foreign) indices)] + local-env (list/map (|>> #reference.Local) indices) + foreign-env (list/map (|>> #reference.Foreign) indices)] [arity bodyA predictionA] (: (r.Random [Arity Analysis Variable]) (loop [arity +1 current-env foreign-env] @@ -72,17 +73,17 @@ (list/map (function (_ pick) (maybe.assume (list.nth pick current-env))) picks)) - #let [picked-env (list/map (|>> #///reference.Foreign) picks)]] + #let [picked-env (list/map (|>> #reference.Foreign) picks)]] (wrap [arity - (#analysisL.Function picked-env bodyA) + (#analysis.Function picked-env bodyA) predictionA])) (do @ [chosen (pick (list.size current-env))] (wrap [arity - (#analysisL.Reference (///reference.foreign chosen)) + (#analysis.Reference (reference.foreign chosen)) (maybe.assume (dict.get chosen resolver))])))))))] (wrap [arity - (#analysisL.Function local-env bodyA) + (#analysis.Function local-env bodyA) predictionA]))) (def: local-function @@ -94,13 +95,13 @@ [nest?' r.bit [arity' bodyA predictionA] (recur (inc arity) nest?')] (wrap [arity' - (#analysisL.Function (list) bodyA) + (#analysis.Function (list) bodyA) predictionA])) (do r.Monad [chosen (|> r.nat (:: @ map (|>> (n/% +100) (n/max +2))))] (wrap [arity - (#analysisL.Reference (///reference.local chosen)) - (|> chosen (n/+ (dec arity)) #///reference.Local)]))))) + (#analysis.Reference (reference.local chosen)) + (|> chosen (n/+ (dec arity)) #reference.Local)]))))) (context: "Function definition." (<| (seed +13007429814532219492) @@ -112,8 +113,8 @@ ($_ seq (test "Nested functions will get folded together." (|> function//constant - (expressionS.synthesizer extensionL.empty) - (///compiler.run //.init) + expression.synthesize + (compiler.run [bundle.empty //.init]) (case> (^ (#error.Success (//.function/abstraction [environment arity output]))) (and (n/= arity//constant arity) (//primitive.corresponds? prediction//constant output)) @@ -122,9 +123,9 @@ (n/= +0 arity//constant)))) (test "Folded functions provide direct access to environment variables." (|> function//environment - (expressionS.synthesizer extensionL.empty) - (///compiler.run //.init) - (case> (^ (#error.Success (//.function/abstraction [environment arity (#//.Reference (///reference.variable output))]))) + expression.synthesize + (compiler.run [bundle.empty //.init]) + (case> (^ (#error.Success (//.function/abstraction [environment arity (#//.Reference (reference.variable output))]))) (and (n/= arity//environment arity) (variable/= prediction//environment output)) @@ -132,9 +133,9 @@ #0))) (test "Folded functions properly offset local variables." (|> function//local - (expressionS.synthesizer extensionL.empty) - (///compiler.run //.init) - (case> (^ (#error.Success (//.function/abstraction [environment arity (#//.Reference (///reference.variable output))]))) + expression.synthesize + (compiler.run [bundle.empty //.init]) + (case> (^ (#error.Success (//.function/abstraction [environment arity (#//.Reference (reference.variable output))]))) (and (n/= arity//local arity) (variable/= prediction//local output)) @@ -150,9 +151,9 @@ argsA (r.list arity //primitive.primitive)] ($_ seq (test "Can synthesize function application." - (|> (analysisL.apply [funcA argsA]) - (expressionS.synthesizer extensionL.empty) - (///compiler.run //.init) + (|> (analysis.apply [funcA argsA]) + expression.synthesize + (compiler.run [bundle.empty //.init]) (case> (^ (#error.Success (//.function/apply [funcS argsS]))) (and (//primitive.corresponds? funcA funcS) (list.every? (product.uncurry //primitive.corresponds?) @@ -161,9 +162,9 @@ _ #0))) (test "Function application on no arguments just synthesizes to the function itself." - (|> (analysisL.apply [funcA (list)]) - (expressionS.synthesizer extensionL.empty) - (///compiler.run //.init) + (|> (analysis.apply [funcA (list)]) + expression.synthesize + (compiler.run [bundle.empty //.init]) (case> (#error.Success funcS) (//primitive.corresponds? funcA funcS) diff --git a/stdlib/test/test/lux/language/compiler/synthesis/primitive.lux b/stdlib/test/test/lux/language/compiler/synthesis/primitive.lux index 0bf5d9765..86eecb600 100644 --- a/stdlib/test/test/lux/language/compiler/synthesis/primitive.lux +++ b/stdlib/test/test/lux/language/compiler/synthesis/primitive.lux @@ -8,12 +8,13 @@ [error] [text format]] - ["." language - ["///." compiler - [".L" analysis (#+ Analysis)] + [language + ["." compiler + [analysis (#+ Analysis)] ["//" synthesis (#+ Synthesis) - [".S" expression]] - [".L" extension]]] + [expression]] + [extension + [bundle]]]] [math ["r" random]] test]) @@ -21,7 +22,7 @@ (def: #export primitive (r.Random Analysis) (do r.Monad - [primitive (: (r.Random analysisL.Primitive) + [primitive (: (r.Random analysis.Primitive) ($_ r.alt (wrap []) r.bit @@ -30,37 +31,37 @@ r.rev r.frac (r.unicode +5)))] - (wrap (#analysisL.Primitive primitive)))) + (wrap (#analysis.Primitive primitive)))) (def: #export (corresponds? analysis synthesis) (-> Analysis Synthesis Bit) (case [synthesis analysis] [(#//.Primitive (#//.Text valueS)) - (#analysisL.Primitive (#analysisL.Unit valueA))] + (#analysis.Primitive (#analysis.Unit valueA))] (is? valueS (:coerce Text valueA)) [(#//.Primitive (#//.Bit valueS)) - (#analysisL.Primitive (#analysisL.Bit valueA))] + (#analysis.Primitive (#analysis.Bit valueA))] (is? valueS valueA) [(#//.Primitive (#//.I64 valueS)) - (#analysisL.Primitive (#analysisL.Nat valueA))] + (#analysis.Primitive (#analysis.Nat valueA))] (is? valueS (.i64 valueA)) [(#//.Primitive (#//.I64 valueS)) - (#analysisL.Primitive (#analysisL.Int valueA))] + (#analysis.Primitive (#analysis.Int valueA))] (is? valueS (.i64 valueA)) [(#//.Primitive (#//.I64 valueS)) - (#analysisL.Primitive (#analysisL.Rev valueA))] + (#analysis.Primitive (#analysis.Rev valueA))] (is? valueS (.i64 valueA)) [(#//.Primitive (#//.F64 valueS)) - (#analysisL.Primitive (#analysisL.Frac valueA))] + (#analysis.Primitive (#analysis.Frac valueA))] (is? valueS valueA) [(#//.Primitive (#//.Text valueS)) - (#analysisL.Primitive (#analysisL.Text valueA))] + (#analysis.Primitive (#analysis.Text valueA))] (is? valueS valueA) _ @@ -69,28 +70,28 @@ (context: "Primitives." (<| (times +100) (do @ - [%bit% r.bit - %nat% r.nat - %int% r.int - %rev% r.rev - %frac% r.frac - %text% (r.unicode +5)] + [|bit| r.bit + |nat| r.nat + |int| r.int + |rev| r.rev + |frac| r.frac + |text| (r.unicode +5)] (`` ($_ seq (~~ (do-template [ ] [(test (format "Can synthesize " ".") - (|> (#analysisL.Primitive ( )) - (expressionS.synthesizer extensionL.empty) - (///compiler.run //.init) + (|> (#analysis.Primitive ( )) + expression.synthesize + (compiler.run [bundle.empty //.init]) (case> (#error.Success (#//.Primitive ( value))) (is? value) _ #0)))] - ["unit" #analysisL.Unit #//.Text //.unit] - ["bit" #analysisL.Bit #//.Bit %bit%] - ["nat" #analysisL.Nat #//.I64 (.i64 %nat%)] - ["int" #analysisL.Int #//.I64 (.i64 %int%)] - ["rev" #analysisL.Rev #//.I64 (.i64 %rev%)] - ["frac" #analysisL.Frac #//.F64 %frac%] - ["text" #analysisL.Text #//.Text %text%]))))))) + ["unit" #analysis.Unit #//.Text //.unit] + ["bit" #analysis.Bit #//.Bit |bit|] + ["nat" #analysis.Nat #//.I64 (.i64 |nat|)] + ["int" #analysis.Int #//.I64 (.i64 |int|)] + ["rev" #analysis.Rev #//.I64 (.i64 |rev|)] + ["frac" #analysis.Frac #//.F64 |frac|] + ["text" #analysis.Text #//.Text |text|]))))))) diff --git a/stdlib/test/test/lux/language/compiler/synthesis/structure.lux b/stdlib/test/test/lux/language/compiler/synthesis/structure.lux index d3845929c..cb82f9131 100644 --- a/stdlib/test/test/lux/language/compiler/synthesis/structure.lux +++ b/stdlib/test/test/lux/language/compiler/synthesis/structure.lux @@ -11,11 +11,12 @@ [collection [list]]] [language - ["///." compiler - [".L" analysis] + ["." compiler + [analysis] ["//" synthesis (#+ Synthesis) - [".S" expression]] - [".L" extension]]] + [expression]] + [extension + [bundle]]]] [math ["r" random]] test] @@ -29,9 +30,9 @@ memberA //primitive.primitive] ($_ seq (test "Can synthesize variants." - (|> (analysisL.sum-analysis size tagA memberA) - (expressionS.synthesizer extensionL.empty) - (///compiler.run //.init) + (|> (analysis.sum-analysis size tagA memberA) + expression.synthesize + (compiler.run [bundle.empty //.init]) (case> (#error.Success (#//.Structure (#//.Variant [leftsS right?S valueS]))) (let [tagS (if right?S (inc leftsS) leftsS)] (and (n/= tagA tagS) @@ -49,9 +50,9 @@ membersA (r.list size //primitive.primitive)] ($_ seq (test "Can synthesize tuple." - (|> (analysisL.product-analysis membersA) - (expressionS.synthesizer extensionL.empty) - (///compiler.run //.init) + (|> (analysis.product-analysis membersA) + expression.synthesize + (compiler.run [bundle.empty //.init]) (case> (#error.Success (#//.Structure (#//.Tuple membersS))) (and (n/= size (list.size membersS)) (list.every? (product.uncurry //primitive.corresponds?) -- cgit v1.2.3