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. --- .../lux/language/compiler/synthesis/case.lux | 20 ++-- .../lux/language/compiler/synthesis/expression.lux | 119 ++++++++++----------- .../lux/language/compiler/synthesis/function.lux | 10 +- .../lux/language/compiler/synthesis/loop.lux | 7 +- 4 files changed, 74 insertions(+), 82 deletions(-) (limited to 'stdlib/source') diff --git a/stdlib/source/lux/language/compiler/synthesis/case.lux b/stdlib/source/lux/language/compiler/synthesis/case.lux index 045abbde7..92a17fa71 100644 --- a/stdlib/source/lux/language/compiler/synthesis/case.lux +++ b/stdlib/source/lux/language/compiler/synthesis/case.lux @@ -11,15 +11,15 @@ format] [number ("frac/" Equivalence)] [collection [list ("list/" Fold Monoid)]]]] - [// (#+ Path Synthesis) + [// (#+ Path Synthesis Operation Compiler) [function] - [/// - [reference] - [compiler (#+ Operation) ("operation/" Monad)] - [analysis (#+ Pattern Match Analysis)]]]) + ["/." // ("operation/" Monad) + [analysis (#+ Pattern Match Analysis)] + [// + [reference]]]]) (def: (path' pattern bodyC) - (-> Pattern (Operation //.State Path) (Operation //.State Path)) + (-> Pattern (Operation Path) (Operation Path)) (case pattern (#analysis.Simple simple) (case simple @@ -38,7 +38,7 @@ [#analysis.Text #//.Text])) (#analysis.Bind register) - (<| (do compiler.Monad + (<| (do ///.Monad [arity //.scope-arity]) (:: @ map (|>> (#//.Seq (#//.Bind (if (function.nested? arity) (n/+ (dec arity) register) @@ -76,7 +76,7 @@ (list.reverse (list.enumerate tuple))))))) (def: #export (path synthesize pattern bodyA) - (-> //.Synthesizer Pattern Analysis (Operation //.State Path)) + (-> Compiler Pattern Analysis (Operation Path)) (path' pattern (operation/map (|>> #//.Then) (synthesize bodyA)))) (def: #export (weave leftP rightP) @@ -126,8 +126,8 @@ ))) (def: #export (synthesize synthesize^ inputA [headB tailB+]) - (-> //.Synthesizer Analysis Match (Operation //.State Synthesis)) - (do compiler.Monad + (-> Compiler Analysis Match (Operation Synthesis)) + (do ///.Monad [inputS (synthesize^ inputA)] (with-expansions [ (as-is (^multi (^ (#analysis.Reference (reference.local outputR))) diff --git a/stdlib/source/lux/language/compiler/synthesis/expression.lux b/stdlib/source/lux/language/compiler/synthesis/expression.lux index f6d68fc05..be20b7b0b 100644 --- a/stdlib/source/lux/language/compiler/synthesis/expression.lux +++ b/stdlib/source/lux/language/compiler/synthesis/expression.lux @@ -1,24 +1,20 @@ (.module: [lux (#- primitive) [control - [monad (#+ do)] - ["ex" exception (#+ exception:)]] + [monad (#+ do)]] [data [maybe] [collection [list ("list/" Functor)] ["dict" dictionary (#+ Dictionary)]]]] - [// (#+ Synthesis) + [// (#+ Synthesis Compiler) [function] [case] - [/// - [reference] - ["." compiler ("operation/" Monad) - [analysis (#+ Analysis)] - [extension (#+ Extension)]]]]) - -(exception: #export (unknown-synthesis-extension {name Text}) - name) + ["/." // ("operation/" Monad) + [analysis (#+ Analysis)] + [extension] + [// + [reference]]]]) (def: (primitive analysis) (-> analysis.Primitive //.Primitive) @@ -40,64 +36,59 @@ [#analysis.Int #//.I64] [#analysis.Rev #//.I64]))) -(def: #export (synthesizer extensions) - (-> (Extension extension.Synthesis) //.Synthesizer) - (function (synthesize analysis) - (case analysis - (#analysis.Primitive analysis') - (operation/wrap (#//.Primitive (..primitive analysis'))) +(def: #export (synthesize analysis) + Compiler + (case analysis + (#analysis.Primitive analysis') + (operation/wrap (#//.Primitive (..primitive analysis'))) - (#analysis.Structure composite) - (case (analysis.variant analysis) - (#.Some variant) - (do compiler.Monad - [valueS (synthesize (get@ #analysis.value variant))] - (wrap (#//.Structure (#//.Variant (set@ #analysis.value valueS variant))))) + (#analysis.Structure composite) + (case (analysis.variant analysis) + (#.Some variant) + (do ///.Monad + [valueS (synthesize (get@ #analysis.value variant))] + (wrap (#//.Structure (#//.Variant (set@ #analysis.value valueS variant))))) - _ - (do compiler.Monad - [tupleS (monad.map @ synthesize (analysis.tuple analysis))] - (wrap (#//.Structure (#//.Tuple tupleS))))) + _ + (do ///.Monad + [tupleS (monad.map @ synthesize (analysis.tuple analysis))] + (wrap (#//.Structure (#//.Tuple tupleS))))) - (#analysis.Apply _) - (function.apply (|>> synthesize //.indirectly) analysis) + (#analysis.Apply _) + (function.apply (|>> synthesize //.indirectly) analysis) - (#analysis.Function environmentA bodyA) - (function.function synthesize environmentA bodyA) + (#analysis.Function environmentA bodyA) + (function.function synthesize environmentA bodyA) - (#analysis.Extension name args) - (case (dict.get name extensions) - #.None - (compiler.throw unknown-synthesis-extension name) - - (#.Some extension) - (extension (|>> synthesize //.indirectly) args)) + (#analysis.Extension name args) + (extension.apply (|>> synthesize //.indirectly) + [name args]) - (#analysis.Reference reference) - (case reference - (#reference.Constant constant) - (operation/wrap (#//.Reference reference)) + (#analysis.Reference reference) + (case reference + (#reference.Constant constant) + (operation/wrap (#//.Reference reference)) - (#reference.Variable var) - (do compiler.Monad - [resolver //.resolver] - (case var - (#reference.Local register) - (do @ - [arity //.scope-arity] - (wrap (if (function.nested? arity) - (if (n/= +0 register) - (|> (dec arity) - (list.n/range +1) - (list/map (|>> //.variable/local)) - [(//.variable/local +0)] - //.function/apply) - (#//.Reference (#reference.Variable (function.adjust arity #0 var)))) - (#//.Reference (#reference.Variable var))))) - - (#reference.Foreign register) - (wrap (|> resolver (dict.get var) (maybe.default var) #reference.Variable #//.Reference))))) + (#reference.Variable var) + (do ///.Monad + [resolver //.resolver] + (case var + (#reference.Local register) + (do @ + [arity //.scope-arity] + (wrap (if (function.nested? arity) + (if (n/= +0 register) + (|> (dec arity) + (list.n/range +1) + (list/map (|>> //.variable/local)) + [(//.variable/local +0)] + //.function/apply) + (#//.Reference (#reference.Variable (function.adjust arity #0 var)))) + (#//.Reference (#reference.Variable var))))) + + (#reference.Foreign register) + (wrap (|> resolver (dict.get var) (maybe.default var) #reference.Variable #//.Reference))))) - (#analysis.Case inputA branchesAB+) - (case.synthesize (|>> synthesize //.indirectly) inputA branchesAB+) - ))) + (#analysis.Case inputA branchesAB+) + (case.synthesize (|>> synthesize //.indirectly) inputA branchesAB+) + )) diff --git a/stdlib/source/lux/language/compiler/synthesis/function.lux b/stdlib/source/lux/language/compiler/synthesis/function.lux index e73621b5c..0fadbc6d1 100644 --- a/stdlib/source/lux/language/compiler/synthesis/function.lux +++ b/stdlib/source/lux/language/compiler/synthesis/function.lux @@ -11,11 +11,11 @@ [collection [list ("list/" Functor Monoid Fold)] ["dict" dictionary (#+ Dictionary)]]]] - [// (#+ Synthesis Synthesizer) + [// (#+ Synthesis Operation Compiler) [loop] [/// [reference (#+ Variable)] - [compiler (#+ Operation) + ["." compiler [analysis (#+ Environment Arity Analysis)]]]]) (def: #export nested? @@ -45,7 +45,7 @@ [apply args]))) (def: #export (apply synthesize) - (-> Synthesizer Synthesizer) + (-> Compiler Compiler) (.function (_ exprA) (let [[funcA argsA] (unfold exprA)] (do (state.Monad error.Monad) @@ -75,7 +75,7 @@ "") (def: return - (All [a] (-> (Maybe a) (Operation //.State a))) + (All [a] (-> (Maybe a) (Operation a))) (|>> (case> (#.Some output) (:: compiler.Monad wrap output) @@ -83,7 +83,7 @@ (compiler.throw cannot-prepare-function-body [])))) (def: #export (function synthesize environment body) - (-> Synthesizer Environment Analysis (Operation //.State Synthesis)) + (-> Compiler Environment Analysis (Operation Synthesis)) (do compiler.Monad [direct? //.direct? arity //.scope-arity diff --git a/stdlib/source/lux/language/compiler/synthesis/loop.lux b/stdlib/source/lux/language/compiler/synthesis/loop.lux index 95666656b..ea6589f21 100644 --- a/stdlib/source/lux/language/compiler/synthesis/loop.lux +++ b/stdlib/source/lux/language/compiler/synthesis/loop.lux @@ -13,7 +13,8 @@ [/// [reference (#+ Register Variable)] [compiler - [analysis (#+ Environment)]]]]) + [analysis (#+ Environment)] + [extension]]]]) (type: #export (Transform a) (-> a (Maybe a))) @@ -30,8 +31,8 @@ (template: (recursive-apply args) (#//.Apply (self) args)) -(def: proper Bit #1) -(def: improper Bit #0) +(def: improper #0) +(def: proper #1) (def: (proper? exprS) (-> Synthesis Bit) -- cgit v1.2.3