aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source')
-rw-r--r--stdlib/source/lux/lang/compiler.lux46
-rw-r--r--stdlib/source/lux/lang/extension.lux13
-rw-r--r--stdlib/source/lux/lang/synthesis.lux118
-rw-r--r--stdlib/source/lux/lang/synthesis/case.lux51
-rw-r--r--stdlib/source/lux/lang/synthesis/expression.lux17
-rw-r--r--stdlib/source/lux/lang/synthesis/function.lux19
6 files changed, 128 insertions, 136 deletions
diff --git a/stdlib/source/lux/lang/compiler.lux b/stdlib/source/lux/lang/compiler.lux
new file mode 100644
index 000000000..c2f9af1e2
--- /dev/null
+++ b/stdlib/source/lux/lang/compiler.lux
@@ -0,0 +1,46 @@
+(.module:
+ lux
+ (lux (control [state]
+ ["ex" exception #+ Exception exception:]
+ [monad #+ do])
+ (data [product]
+ [error #+ Error])
+ [function]))
+
+(type: #export (Operation s o)
+ (state.State' Error s o))
+
+(def: #export (run state operation)
+ (All [s o]
+ (-> s (Operation s o) (Error o)))
+ (|> state
+ operation
+ (:: error.Monad<Error> map product.right)))
+
+(def: #export (throw exception parameters)
+ (All [e] (-> (Exception e) e Operation))
+ (state.lift error.Monad<Error>
+ (ex.throw exception parameters)))
+
+(def: #export (localized transform)
+ (All [s o]
+ (-> (-> s s)
+ (-> (Operation s o) (Operation s o))))
+ (function (_ operation)
+ (function (_ state)
+ (case (operation (transform state))
+ (#error.Error error)
+ (#error.Error error)
+
+ (#error.Success [state' output])
+ (#error.Success [state output])))))
+
+(def: #export (with-state state)
+ (All [s o] (-> s (-> (Operation s o) (Operation s o))))
+ (localized (function.constant state)))
+
+(def: #export Monad<Operation>
+ (state.Monad<State'> error.Monad<Error>))
+
+(type: #export (Compiler s i o)
+ (-> i (Operation s o)))
diff --git a/stdlib/source/lux/lang/extension.lux b/stdlib/source/lux/lang/extension.lux
index 6da453148..d9eb90fc9 100644
--- a/stdlib/source/lux/lang/extension.lux
+++ b/stdlib/source/lux/lang/extension.lux
@@ -7,8 +7,9 @@
(coll (dictionary ["dict" unordered #+ Dict])))
[macro])
[// #+ Eval]
- (// [".L" analysis #+ Analyser]
- [".L" synthesis #+ Synthesizer]))
+ [//compiler #+ Operation Compiler]
+ [//analysis #+ Analyser]
+ [//synthesis #+ Synthesizer])
(do-template [<name>]
[(exception: #export (<name> {message Text})
@@ -26,11 +27,13 @@
)
(type: #export Analysis
- (-> Analyser Eval (List Code) (Meta analysisL.Analysis)))
+ (-> Analyser Eval (List Code) (Meta //analysis.Analysis)))
(type: #export Synthesis
- (-> Synthesizer (List analysisL.Analysis)
- (synthesisL.Operation synthesisL.Synthesis)))
+ (-> Synthesizer
+ (Compiler //synthesis.State
+ (List //analysis.Analysis)
+ //synthesis.Synthesis)))
(type: #export Translation
(-> (List Code) (Meta Code)))
diff --git a/stdlib/source/lux/lang/synthesis.lux b/stdlib/source/lux/lang/synthesis.lux
index d68b535dc..359ef445a 100644
--- a/stdlib/source/lux/lang/synthesis.lux
+++ b/stdlib/source/lux/lang/synthesis.lux
@@ -1,15 +1,11 @@
(.module:
[lux #- Scope]
- (lux (control [state]
- ["ex" exception #+ Exception exception:]
- [monad #+ do])
- (data [product]
- [error #+ Error]
- [number]
- (coll (dictionary ["dict" unordered #+ Dict])))
- [function])
+ (lux (control [monad #+ do])
+ (data [error #+ Error]
+ (coll (dictionary ["dict" unordered #+ Dict]))))
[//reference #+ Register Variable Reference]
- [//analysis #+ Environment Special Analysis])
+ [//analysis #+ Environment Special Analysis]
+ [//compiler #+ Operation Compiler])
(type: #export Arity Nat)
@@ -32,12 +28,6 @@
#direct? false
#locals +0})
-(type: (Operation' s o)
- (state.State' Error s o))
-
-(type: #export (Compiler s i o)
- (-> i (Operation' ..State o)))
-
(type: #export Primitive
(#Bool Bool)
(#I64 I64)
@@ -132,84 +122,42 @@
(type: #export Abstraction
(Abstraction' Synthesis))
-(type: #export (Operation a)
- (Operation' ..State a))
-
(def: #export unit Text "")
(type: #export Synthesizer
(Compiler ..State Analysis Synthesis))
-(def: #export (throw exception parameters)
- (All [e] (-> (Exception e) e Operation'))
- (state.lift error.Monad<Error>
- (ex.throw exception parameters)))
-
-(def: #export (run synthesizer analysis)
- (-> Synthesizer Analysis (Error Synthesis))
- (:: error.Monad<Error> map product.right
- (synthesizer analysis ..init)))
-
-(def: (localized' transform)
- (-> (-> State State)
- (All [a] (-> (Operation a) (Operation a))))
- (function (_ operation)
- (function (_ state)
- (case (operation (transform state))
- (#error.Error error)
- (#error.Error error)
-
- (#error.Success [state' output])
- (#error.Success [state output])))))
-
-(def: (localized transform)
- (-> (-> State State)
- (-> Synthesizer Synthesizer))
- (function (_ synthesize)
- (function (_ analysis)
- (localized' transform (synthesize analysis)))))
-
-(do-template [<operation> <synthesizer> <value>]
- [(def: #export <operation>
- (All [a] (-> (Operation a) (Operation a)))
- (localized' (set@ #direct? <value>)))
-
- (def: #export <synthesizer>
- (-> Synthesizer Synthesizer)
- (localized (set@ #direct? <value>)))]
-
- [indirectly' indirectly false]
- [directly' directly true]
- )
+(do-template [<name> <value>]
+ [(def: #export <name>
+ (All [a] (-> (Operation ..State a) (Operation ..State a)))
+ (//compiler.localized (set@ #direct? <value>)))]
-(do-template [<operation> <synthesizer> <type> <tag>]
- [(def: #export (<operation> value)
- (-> <type> (All [a] (-> (Operation a) (Operation a))))
- (localized' (set@ <tag> value)))
+ [indirectly false]
+ [directly true]
+ )
- (def: #export (<synthesizer> value)
- (-> <type> (-> Synthesizer Synthesizer))
- (localized (set@ <tag> value)))]
+(do-template [<name> <type> <tag>]
+ [(def: #export (<name> value)
+ (-> <type> (All [a] (-> (Operation ..State a) (Operation ..State a))))
+ (//compiler.localized (set@ <tag> value)))]
- [with-scope-arity' with-scope-arity Arity #scope-arity]
- [with-resolver' with-resolver Resolver #resolver]
- [with-locals' with-locals Nat #locals]
+ [with-scope-arity Arity #scope-arity]
+ [with-resolver Resolver #resolver]
+ [with-locals Nat #locals]
)
-(def: #export (with-state value)
- (-> ..State (-> Synthesizer Synthesizer))
- (localized (function.constant value)))
-
-(def: #export (with-abstraction-state arity resolver)
- (-> Arity Resolver (-> Synthesizer Synthesizer))
- (with-state {#scope-arity arity
- #resolver resolver
- #direct? true
- #locals arity}))
+(def: #export (with-abstraction arity resolver)
+ (All [o]
+ (-> Arity Resolver
+ (-> (Operation ..State o) (Operation ..State o))))
+ (//compiler.with-state {#scope-arity arity
+ #resolver resolver
+ #direct? true
+ #locals arity}))
(do-template [<name> <tag> <type>]
[(def: #export <name>
- (Operation <type>)
+ (Operation ..State <type>)
(function (_ state)
(#error.Success [state (get@ <tag> state)])))]
@@ -219,13 +167,11 @@
[locals #locals Nat]
)
-(def: #export Operation@Monad (state.Monad<State'> error.Monad<Error>))
-
-(def: #export with-new-local'
- (All [a] (-> (Operation a) (Operation a)))
- (<<| (do Operation@Monad
+(def: #export with-new-local
+ (All [a] (-> (Operation ..State a) (Operation ..State a)))
+ (<<| (do //compiler.Monad<Operation>
[locals ..locals])
- (..with-locals' (inc locals))))
+ (..with-locals (inc locals))))
(do-template [<name> <tag>]
[(template: #export (<name> content)
diff --git a/stdlib/source/lux/lang/synthesis/case.lux b/stdlib/source/lux/lang/synthesis/case.lux
index 5fe32e62d..85065393d 100644
--- a/stdlib/source/lux/lang/synthesis/case.lux
+++ b/stdlib/source/lux/lang/synthesis/case.lux
@@ -10,12 +10,13 @@
[number "frac/" Eq<Frac>]
(coll [list "list/" Fold<List> Monoid<List>])))
[///reference]
+ [///compiler #+ Operation "operation/" Monad<Operation>]
[///analysis #+ Pattern Match Analysis]
- [// #+ Path Synthesis Operation]
+ [// #+ Path Synthesis]
[//function])
(def: (path' pattern bodyC)
- (-> Pattern (Operation Path) (Operation Path))
+ (-> Pattern (Operation //.State Path) (Operation //.State Path))
(case pattern
(#///analysis.Simple simple)
(case simple
@@ -24,9 +25,8 @@
(^template [<from> <to>]
(<from> value)
- (:: //.Operation@Monad map
- (|>> (#//.Seq (#//.Test (|> value <to>))))
- bodyC))
+ (operation/map (|>> (#//.Seq (#//.Test (|> value <to>))))
+ bodyC))
([#///analysis.Bool #//.Bool]
[#///analysis.Nat (<| #//.I64 .i64)]
[#///analysis.Int (<| #//.I64 .i64)]
@@ -35,21 +35,21 @@
[#///analysis.Text #//.Text]))
(#///analysis.Bind register)
- (do //.Operation@Monad
- [arity //.scope-arity]
- (:: @ map (|>> (#//.Seq (#//.Bind (if (//function.nested? arity)
- (n/+ (dec arity) register)
- register))))
- (//.with-new-local' bodyC)))
+ (<| (do ///compiler.Monad<Operation>
+ [arity //.scope-arity])
+ (:: @ map (|>> (#//.Seq (#//.Bind (if (//function.nested? arity)
+ (n/+ (dec arity) register)
+ register)))))
+ //.with-new-local
+ bodyC)
(#///analysis.Complex _)
(case (///analysis.variant-pattern pattern)
(#.Some [lefts right? value-pattern])
- (:: //.Operation@Monad map
- (|>> (#//.Seq (#//.Access (#//.Side (if right?
- (#.Right lefts)
- (#.Left lefts))))))
- (path' value-pattern bodyC))
+ (operation/map (|>> (#//.Seq (#//.Access (#//.Side (if right?
+ (#.Right lefts)
+ (#.Left lefts))))))
+ (path' value-pattern bodyC))
#.None
(let [tuple (///analysis.tuple-pattern pattern)
@@ -64,18 +64,17 @@
(|> (if (or last?
(is? bodyC thenC))
thenC
- (:: //.Operation@Monad map (|>> (#//.Seq #//.Pop)) thenC))
+ (operation/map (|>> (#//.Seq #//.Pop)) thenC))
(path' tuple/member)
- (:: //.Operation@Monad map
- (|>> (#//.Seq (#//.Access (#//.Member (if last?
- (#.Right (dec tuple/idx))
- (#.Left tuple/idx)))))))))))
+ (operation/map (|>> (#//.Seq (#//.Access (#//.Member (if last?
+ (#.Right (dec tuple/idx))
+ (#.Left tuple/idx)))))))))))
bodyC
(list.reverse (list.enumerate tuple)))))))
(def: #export (path synthesize pattern bodyA)
- (-> //.Synthesizer Pattern Analysis (Operation Path))
- (path' pattern (:: //.Operation@Monad map (|>> #//.Then) (synthesize bodyA))))
+ (-> //.Synthesizer Pattern Analysis (Operation //.State Path))
+ (path' pattern (operation/map (|>> #//.Then) (synthesize bodyA))))
(def: #export (weave leftP rightP)
(-> Path Path Path)
@@ -124,8 +123,8 @@
<default>)))
(def: #export (synthesize synthesize^ inputA [headB tailB+])
- (-> //.Synthesizer Analysis Match (Operation Synthesis))
- (do //.Operation@Monad
+ (-> //.Synthesizer Analysis Match (Operation //.State Synthesis))
+ (do ///compiler.Monad<Operation>
[inputS (synthesize^ inputA)]
(case [headB tailB+]
[[(#///analysis.Bind inputR) headB/bodyA]
@@ -139,7 +138,7 @@
_
(do @
[arity //.scope-arity
- headB/bodyS (//.with-new-local'
+ headB/bodyS (//.with-new-local
(synthesize^ headB/bodyA))]
(wrap (//.branch/let [inputS
(if (//function.nested? arity)
diff --git a/stdlib/source/lux/lang/synthesis/expression.lux b/stdlib/source/lux/lang/synthesis/expression.lux
index aab092777..2985d2d08 100644
--- a/stdlib/source/lux/lang/synthesis/expression.lux
+++ b/stdlib/source/lux/lang/synthesis/expression.lux
@@ -6,6 +6,7 @@
(coll [list "list/" Functor<List>]
(dictionary ["dict" unordered #+ Dict]))))
[///reference]
+ [///compiler "operation/" Monad<Operation>]
[///analysis #+ Analysis]
[///extension #+ Extension]
[// #+ Synthesis]
@@ -35,8 +36,6 @@
[#///analysis.Int #//.I64]
[#///analysis.Deg #//.I64])))
-(open: "operation/" //.Operation@Monad)
-
(def: #export (synthesizer extensions)
(-> (Extension ///extension.Synthesis) //.Synthesizer)
(function (synthesize analysis)
@@ -47,17 +46,17 @@
(#///analysis.Structure composite)
(case (///analysis.variant analysis)
(#.Some variant)
- (do //.Operation@Monad
+ (do ///compiler.Monad<Operation>
[valueS (synthesize (get@ #///analysis.value variant))]
(wrap (#//.Structure (#//.Variant (set@ #///analysis.value valueS variant)))))
_
- (do //.Operation@Monad
+ (do ///compiler.Monad<Operation>
[tupleS (monad.map @ synthesize (///analysis.tuple analysis))]
(wrap (#//.Structure (#//.Tuple tupleS)))))
(#///analysis.Apply _)
- (//function.apply (//.indirectly synthesize) analysis)
+ (//function.apply (|>> synthesize //.indirectly) analysis)
(#///analysis.Function environmentA bodyA)
(//function.function synthesize environmentA bodyA)
@@ -65,10 +64,10 @@
(#///analysis.Special name args)
(case (dict.get name extensions)
#.None
- (//.throw unknown-synthesis-extension name)
+ (///compiler.throw unknown-synthesis-extension name)
(#.Some extension)
- (extension (//.indirectly synthesize) args))
+ (extension (|>> synthesize //.indirectly) args))
(#///analysis.Reference reference)
(case reference
@@ -76,7 +75,7 @@
(operation/wrap (#//.Reference reference))
(#///reference.Variable var)
- (do //.Operation@Monad
+ (do ///compiler.Monad<Operation>
[resolver //.resolver]
(case var
(#///reference.Local register)
@@ -96,5 +95,5 @@
(wrap (|> resolver (dict.get var) (maybe.default var) #///reference.Variable #//.Reference)))))
(#///analysis.Case inputA branchesAB+)
- (//case.synthesize (//.indirectly synthesize) inputA branchesAB+)
+ (//case.synthesize (|>> synthesize //.indirectly) inputA branchesAB+)
)))
diff --git a/stdlib/source/lux/lang/synthesis/function.lux b/stdlib/source/lux/lang/synthesis/function.lux
index 8014c3b4a..cc40bea4d 100644
--- a/stdlib/source/lux/lang/synthesis/function.lux
+++ b/stdlib/source/lux/lang/synthesis/function.lux
@@ -9,12 +9,11 @@
(coll [list "list/" Functor<List> Monoid<List> Fold<List>]
(dictionary ["dict" unordered #+ Dict]))))
[///reference #+ Variable]
+ [///compiler #+ Operation]
[///analysis #+ Environment Analysis]
[// #+ Arity Synthesis Synthesizer]
[//loop])
-(def: Operation@Monad (state.Monad<State'> error.Monad<Error>))
-
(def: #export nested?
(-> Arity Bool)
(n/> +1))
@@ -72,16 +71,16 @@
"")
(def: return
- (All [a] (-> (Maybe a) (//.Operation a)))
+ (All [a] (-> (Maybe a) (Operation //.State a)))
(|>> (case> (#.Some output)
- (:: Operation@Monad wrap output)
+ (:: ///compiler.Monad<Operation> wrap output)
#.None
- (//.throw cannot-prepare-function-body []))))
+ (///compiler.throw cannot-prepare-function-body []))))
(def: #export (function synthesize environment body)
- (-> Synthesizer Environment Analysis (//.Operation Synthesis))
- (do Operation@Monad
+ (-> Synthesizer Environment Analysis (Operation //.State Synthesis))
+ (do ///compiler.Monad<Operation>
[direct? //.direct?
arity //.scope-arity
resolver //.resolver
@@ -115,9 +114,9 @@
(list/fold (.function (_ var resolver')
(dict.put var var resolver'))
//.fresh-resolver
- down-environment))
- synthesize' (//.with-abstraction-state function-arity resolver' synthesize)]
- bodyS (synthesize' body)]
+ down-environment))]
+ bodyS (//.with-abstraction function-arity resolver'
+ (synthesize body))]
(case bodyS
(^ (//.function/abstraction [env' down-arity' bodyS']))
(let [arity' (inc down-arity')]