aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--new-luxc/source/luxc/lang/extension/statement.lux156
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/statement.jvm.lux73
-rw-r--r--stdlib/source/lux.lux16
-rw-r--r--stdlib/source/lux/compiler/default/phase.lux16
-rw-r--r--stdlib/source/lux/compiler/default/phase/analysis.lux24
-rw-r--r--stdlib/source/lux/compiler/default/phase/analysis/module.lux2
-rw-r--r--stdlib/source/lux/compiler/default/phase/analysis/structure.lux3
-rw-r--r--stdlib/source/lux/compiler/default/phase/extension/bundle.lux10
-rw-r--r--stdlib/source/lux/compiler/default/phase/extension/statement.lux184
-rw-r--r--stdlib/source/lux/compiler/default/phase/extension/synthesis.lux16
-rw-r--r--stdlib/source/lux/compiler/default/phase/extension/translation.lux16
-rw-r--r--stdlib/source/lux/compiler/default/phase/statement.lux55
-rw-r--r--stdlib/source/lux/compiler/default/phase/synthesis.lux18
-rw-r--r--stdlib/source/lux/compiler/default/phase/translation.lux24
-rw-r--r--stdlib/test/tests.lux13
15 files changed, 331 insertions, 295 deletions
diff --git a/new-luxc/source/luxc/lang/extension/statement.lux b/new-luxc/source/luxc/lang/extension/statement.lux
deleted file mode 100644
index ce1222fed..000000000
--- a/new-luxc/source/luxc/lang/extension/statement.lux
+++ /dev/null
@@ -1,156 +0,0 @@
-(.module:
- lux
- (lux (control [monad #+ do]
- ["ex" exception #+ exception:])
- (data [text]
- text/format
- (coll [list "list/" Functor<List>]
- (dictionary ["dict" unordered #+ Dict])))
- [macro]
- (lang (type ["tc" check]))
- [io #+ IO])
- [// #+ Syntheses]
- (luxc [lang]
- (lang [".L" host]
- [".L" scope]
- (host ["$" jvm])
- (analysis [".A" common]
- [".A" expression])
- (synthesis [".S" expression])
- (translation (jvm [".T" expression]
- [".T" statement]
- [".T" eval]))
- [".L" eval])))
-
-(do-template [<name>]
- [(exception: #export (<name> {message Text})
- message)]
-
- [Invalid-Statement]
- [Invalid-Alias]
- )
-
-(def: (throw-invalid-statement procedure inputsC+)
- (All [a] (-> Text (List Code) (Meta a)))
- (lang.throw Invalid-Statement
- (format "Statement: " procedure "\n"
- " Inputs:"
- (|> inputsC+
- list.enumerate
- (list/map (function (_ [idx inputC])
- (format "\n " (%n idx) " " (%code inputC))))
- (text.join-with "")) "\n")))
-
-(def: (process-annotations syntheses annsC)
- (-> Syntheses Code (Meta [$.Inst Code]))
- (do macro.Monad<Meta>
- [[_ annsA] (lang.with-scope
- (lang.with-type Code
- (expressionA.analyser evalL.eval annsC)))
- annsI (expressionT.translate (expressionS.synthesize syntheses annsA))
- annsV (evalT.eval annsI)]
- (wrap [annsI (:coerce Code annsV)])))
-
-(def: (ensure-valid-alias def-name annotations value)
- (-> Text Code Code (Meta Any))
- (case [annotations value]
- (^multi [[_ (#.Record pairs)] [_ (#.Identifier _)]]
- (|> pairs list.size (n/= +1)))
- (:: macro.Monad<Meta> wrap [])
-
- _
- (lang.throw Invalid-Alias def-name)))
-
-(def: (lux//def procedure)
- (-> Text //.Statement)
- (function (_ inputsC+)
- (case inputsC+
- (^ (list [_ (#.Identifier ["" def-name])] valueC annotationsC))
- (hostL.with-context def-name
- (lang.with-fresh-type-env
- (do macro.Monad<Meta>
- [syntheses //.all-syntheses
- [annotationsI annotationsV] (process-annotations syntheses annotationsC)]
- (case (macro.get-identifier-ann (name-of #.alias) annotationsV)
- (#.Some real-def)
- (do @
- [_ (ensure-valid-alias def-name annotationsV valueC)
- _ (lang.with-scope
- (statementT.translate-def def-name Nothing id annotationsV))]
- (wrap []))
-
- #.None
- (do @
- [[_ valueT valueA] (lang.with-scope
- (if (macro.type? (:coerce Code annotationsV))
- (do @
- [valueA (lang.with-type Type
- (expressionA.analyser evalL.eval valueC))]
- (wrap [Type valueA]))
- (commonA.with-unknown-type
- (expressionA.analyser evalL.eval valueC))))
- valueT (lang.with-type-env
- (tc.clean valueT))
- valueI (expressionT.translate (expressionS.synthesize syntheses valueA))
- _ (lang.with-scope
- (statementT.translate-def def-name valueT valueI annotationsV))]
- (wrap []))))))
-
- _
- (throw-invalid-statement procedure inputsC+))))
-
-(def: (lux//program procedure)
- (-> Text //.Statement)
- (function (_ inputsC+)
- (case inputsC+
- (^ (list [_ (#.Identifier ["" args])] programC))
- (do macro.Monad<Meta>
- [[_ programA] (<| lang.with-scope
- (scopeL.with-local [args (type (List Text))])
- (lang.with-type (type (IO Any)))
- (expressionA.analyser evalL.eval programC))
- syntheses //.all-syntheses
- programI (expressionT.translate (expressionS.synthesize syntheses programA))
- _ (statementT.translate-program programI)]
- (wrap []))
-
- _
- (throw-invalid-statement procedure inputsC+))))
-
-(do-template [<mame> <type> <installer>]
- [(def: (<mame> procedure)
- (-> Text //.Statement)
- (function (_ inputsC+)
- (case inputsC+
- (^ (list [_ (#.Text name)] valueC))
- (do macro.Monad<Meta>
- [[_ valueA] (lang.with-scope
- (lang.with-type <type>
- (expressionA.analyser evalL.eval valueC)))
- syntheses //.all-syntheses
- valueI (expressionT.translate (expressionS.synthesize syntheses valueA))
- valueV (evalT.eval valueI)
- _ (<installer> name (:coerce <type> valueV))]
- (wrap []))
-
- _
- (throw-invalid-statement procedure inputsC+))))]
-
- [lux//analysis //.Analysis //.install-analysis]
- [lux//synthesis //.Synthesis //.install-synthesis]
- [lux//translation //.Translation //.install-translation]
- [lux//statement //.Statement //.install-statement])
-
-(def: #export defaults
- (Dict Text //.Statement)
- (`` (|> (dict.new text.Hash<Text>)
- (~~ (do-template [<name> <extension>]
- [(dict.put <name> (<extension> <name>))]
-
- ["lux def" lux//def]
- ["lux program" lux//program]
- ["lux analysis" lux//analysis]
- ["lux synthesis" lux//synthesis]
- ["lux translation" lux//translation]
- ["lux statement" lux//statement]
- )))))
diff --git a/new-luxc/source/luxc/lang/translation/jvm/statement.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/statement.jvm.lux
index 14208903c..7461d981f 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/statement.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/statement.jvm.lux
@@ -7,8 +7,7 @@
[text "text/" Monoid<Text> Hash<Text>]
text/format
(coll [list "list/" Functor<List> Fold<List>]))
- [macro]
- [host])
+ [macro])
(luxc ["&" lang]
["&." io]
(lang (host ["$" jvm]
@@ -21,76 +20,6 @@
(// [".T" common]
[".T" runtime]))
-(do-template [<name>]
- [(exception: #export (<name> {message Text})
- message)]
-
- [Invalid-Definition-Value]
- [Cannot-Evaluate-Definition]
- )
-
-(host.import: java/lang/reflect/Field
- (get [#? Object] #try #? Object))
-
-(host.import: (java/lang/Class c)
- (getField [String] #try Field))
-
-(def: #export (translate-def def-name valueT valueI metaV)
- (-> Text Type $.Inst Code (Meta Any))
- (do macro.Monad<Meta>
- [current-module macro.current-module-name
- #let [def-name [current-module def-name]]]
- (case (macro.get-identifier-ann (name-of #.alias) metaV)
- (#.Some real-def)
- (do @
- [[realT realA realV] (macro.find-def real-def)
- _ (&module.define def-name [realT metaV realV])]
- (wrap []))
-
- _
- (do @
- [#let [normal-name (format (&.normalize-name def-name) (%n (text/hash def-name)))
- bytecode-name (format current-module "/" normal-name)
- class-name (format (text.replace-all "/" "." current-module) "." normal-name)
- bytecode ($d.class #$.V1_6
- #$.Public $.finalC
- bytecode-name
- (list) ["java.lang.Object" (list)]
- (list)
- (|>> ($d.field #$.Public ($.++F $.finalF $.staticF) commonT.value-field commonT.$Object)
- ($d.method #$.Public $.staticM "<clinit>" ($t.method (list) #.None (list))
- (|>> valueI
- ($i.PUTSTATIC bytecode-name commonT.value-field commonT.$Object)
- $i.RETURN))))]
- _ (commonT.store-class class-name bytecode)
- class (commonT.load-class class-name)
- valueV (: (Meta Any)
- (case (do e.Monad<Error>
- [field (Class::getField [commonT.value-field] class)]
- (Field::get [#.None] field))
- (#e.Success #.None)
- (&.throw Invalid-Definition-Value (%name def-name))
-
- (#e.Success (#.Some valueV))
- (wrap valueV)
-
- (#e.Error error)
- (&.throw Cannot-Evaluate-Definition
- (format "Definition: " (%name def-name) "\n"
- "Error:\n"
- error))))
- _ (&module.define def-name [valueT metaV valueV])
- _ (if (macro.type? metaV)
- (case (macro.declared-tags metaV)
- #.Nil
- (wrap [])
-
- tags
- (&module.declare-tags tags (macro.export? metaV) (:coerce Type valueV)))
- (wrap []))
- #let [_ (log! (format "DEF " (%name def-name)))]]
- (commonT.record-artifact (format bytecode-name ".class") bytecode)))))
-
(def: #export (translate-program programI)
(-> $.Inst (Meta Any))
(let [nilI runtimeT.noneI
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index 34ceb43ba..1c7969f99 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -5832,10 +5832,16 @@
(fail "Wrong syntax for undefined")))
(macro: #export (:of tokens)
- {#.doc (doc "Generates the type corresponding to a given definition or variable."
- (let [my-num (: Int +123)]
+ {#.doc (doc "Generates the type corresponding to a given expression."
+ "Example #1:"
+ (let [my-num +123]
(:of my-num))
"=="
+ Int
+ "-------------------"
+ "Example #2:"
+ (:of +123)
+ "=="
Int)}
(case tokens
(^ (list [_ (#Identifier var-name)]))
@@ -5843,6 +5849,12 @@
[var-type (find-type var-name)]
(wrap (list (type-to-code var-type))))
+ (^ (list expression))
+ (do Monad<Meta>
+ [g!temp (gensym "g!temp")]
+ (wrap (list (` (let [(~ g!temp) (~ expression)]
+ (..:of (~ g!temp)))))))
+
_
(fail "Wrong syntax for :of")))
diff --git a/stdlib/source/lux/compiler/default/phase.lux b/stdlib/source/lux/compiler/default/phase.lux
index ae146be74..85567e45c 100644
--- a/stdlib/source/lux/compiler/default/phase.lux
+++ b/stdlib/source/lux/compiler/default/phase.lux
@@ -33,6 +33,22 @@
operation
(:: error.Monad<Error> map product.right)))
+(def: #export state
+ (All [s o]
+ (Operation s s))
+ (function (_ state)
+ (#error.Success [state state])))
+
+(def: #export (sub [get set] operation)
+ (All [s s' o]
+ (-> [(-> s s') (-> s' s s)]
+ (Operation s' o)
+ (Operation s o)))
+ (function (_ state)
+ (do error.Monad<Error>
+ [[state' output] (operation (get state))]
+ (wrap [(set state' state) output]))))
+
(def: #export fail
(-> Text Operation)
(|>> error.fail (state.lift error.Monad<Error>)))
diff --git a/stdlib/source/lux/compiler/default/phase/analysis.lux b/stdlib/source/lux/compiler/default/phase/analysis.lux
index 72d2a3485..ccf46b873 100644
--- a/stdlib/source/lux/compiler/default/phase/analysis.lux
+++ b/stdlib/source/lux/compiler/default/phase/analysis.lux
@@ -51,20 +51,16 @@
(#Apply Analysis Analysis)
(#Extension (Extension Analysis)))
-(type: #export State+
- (extension.State .Lux Code Analysis))
-
-(type: #export Operation
- (extension.Operation .Lux Code Analysis))
-
-(type: #export Phase
- (extension.Phase .Lux Code Analysis))
-
-(type: #export Handler
- (extension.Handler .Lux .Code Analysis))
-
-(type: #export Bundle
- (extension.Bundle .Lux .Code Analysis))
+(do-template [<special> <general>]
+ [(type: #export <special>
+ (<general> .Lux Code Analysis))]
+
+ [State+ extension.State]
+ [Operation extension.Operation]
+ [Phase extension.Phase]
+ [Handler extension.Handler]
+ [Bundle extension.Bundle]
+ )
(type: #export Branch
(Branch' Analysis))
diff --git a/stdlib/source/lux/compiler/default/phase/analysis/module.lux b/stdlib/source/lux/compiler/default/phase/analysis/module.lux
index 61d3a2ec6..5812ef3d2 100644
--- a/stdlib/source/lux/compiler/default/phase/analysis/module.lux
+++ b/stdlib/source/lux/compiler/default/phase/analysis/module.lux
@@ -112,7 +112,7 @@
[state] #error.Success))))
(def: #export (define name definition)
- (-> Text Definition (Operation []))
+ (-> Text Definition (Operation Any))
(do ///.Monad<Operation>
[self-name (extension.lift macro.current-module-name)
self (extension.lift macro.current-module)]
diff --git a/stdlib/source/lux/compiler/default/phase/analysis/structure.lux b/stdlib/source/lux/compiler/default/phase/analysis/structure.lux
index f894679ef..2977eb777 100644
--- a/stdlib/source/lux/compiler/default/phase/analysis/structure.lux
+++ b/stdlib/source/lux/compiler/default/phase/analysis/structure.lux
@@ -22,8 +22,7 @@
["." primitive]
["." inference]
["/." //
- ["." extension]
- ["//." //]]])
+ ["." extension]]])
(exception: #export (invalid-variant-type {type Type} {tag Tag} {code Code})
(ex.report ["Type" (%type type)]
diff --git a/stdlib/source/lux/compiler/default/phase/extension/bundle.lux b/stdlib/source/lux/compiler/default/phase/extension/bundle.lux
index e2d36fa73..4fe68b23c 100644
--- a/stdlib/source/lux/compiler/default/phase/extension/bundle.lux
+++ b/stdlib/source/lux/compiler/default/phase/extension/bundle.lux
@@ -8,7 +8,7 @@
format]
[collection
[list ("list/." Functor<List>)]
- ["dict" dictionary (#+ Dictionary)]]]]
+ ["." dictionary (#+ Dictionary)]]]]
[// (#+ Handler Bundle)])
(exception: #export (incorrect-arity {name Text} {arity Nat} {args Nat})
@@ -22,17 +22,17 @@
## [Utils]
(def: #export empty
Bundle
- (dict.new text.Hash<Text>))
+ (dictionary.new text.Hash<Text>))
(def: #export (install name anonymous)
(All [s i o]
(-> Text (Handler s i o)
(-> (Bundle s i o) (Bundle s i o))))
- (dict.put name anonymous))
+ (dictionary.put name anonymous))
(def: #export (prefix prefix)
(All [s i o]
(-> Text (-> (Bundle s i o) (Bundle s i o))))
- (|>> dict.entries
+ (|>> dictionary.entries
(list/map (function (_ [key val]) [(format prefix " " key) val]))
- (dict.from-list text.Hash<Text>)))
+ (dictionary.from-list text.Hash<Text>)))
diff --git a/stdlib/source/lux/compiler/default/phase/extension/statement.lux b/stdlib/source/lux/compiler/default/phase/extension/statement.lux
new file mode 100644
index 000000000..2c2bf4464
--- /dev/null
+++ b/stdlib/source/lux/compiler/default/phase/extension/statement.lux
@@ -0,0 +1,184 @@
+(.module:
+ [lux #*
+ [control
+ [monad (#+ do)]
+ pipe]
+ [data
+ [collection
+ [list ("list/." Functor<List>)]
+ ["." dictionary]]]
+ ["." macro]
+ [type (#+ :share)
+ ["." check]]]
+ [//
+ ["/." // (#+ Eval)
+ ["." analysis
+ ["." module]
+ ["." type]]
+ ["." synthesis]
+ ["." translation]
+ ["." statement (#+ Operation Handler Bundle)]
+ ["." extension
+ ["." bundle]]
+ [//
+ ["." evaluation]]]])
+
+(do-template [<name> <component> <operation>]
+ [(def: (<name> operation)
+ (All [anchor expression statement output]
+ (-> (<operation> output) (Operation anchor expression statement output)))
+ (extension.lift
+ (///.sub [(get@ [<component> #statement.state])
+ (set@ [<component> #statement.state])]
+ operation)))]
+
+ [lift-analysis! #statement.analysis analysis.Operation]
+ [lift-synthesis! #statement.synthesis synthesis.Operation]
+ [lift-translation! #statement.translation (translation.Operation anchor expression statement)]
+ )
+
+(def: (compile ?name ?type codeC)
+ (All [anchor expression statement]
+ (-> (Maybe Name) (Maybe Type) Code
+ (Operation anchor expression statement [Type expression Any])))
+ (do ///.Monad<Operation>
+ [state (extension.lift ///.state)
+ #let [analyse (get@ [#statement.analysis #statement.phase] state)
+ synthesize (get@ [#statement.synthesis #statement.phase] state)
+ translate (get@ [#statement.translation #statement.phase] state)]
+ [_ code//type codeA] (lift-analysis!
+ (analysis.with-scope
+ (type.with-fresh-env
+ (case ?type
+ (#.Some type)
+ (type.with-type type
+ (do @
+ [codeA (analyse codeC)]
+ (wrap [type codeA])))
+
+ #.None
+ (do @
+ [[code//type codeA] (type.with-inference (analyse codeC))
+ code//type (type.with-env
+ (check.clean code//type))]
+ (wrap [code//type codeA]))))))
+ codeS (lift-synthesis!
+ (synthesize codeA))]
+ (lift-translation!
+ (do @
+ [codeT (translate codeS)
+ codeV (case ?name
+ (#.Some name)
+ (translation.define! name codeT)
+
+ #.None
+ (translation.evaluate! codeT))]
+ (wrap [code//type codeT codeV])))))
+
+(def: lux::def
+ Handler
+ (function (_ extension-name phase inputsC+)
+ (case inputsC+
+ (^ (list [_ (#.Identifier ["" def-name])] valueC annotationsC))
+ (do ///.Monad<Operation>
+ [[_ annotationsT annotationsV] (compile #.None (#.Some Code) annotationsC)
+ #let [annotationsV (:coerce Code annotationsV)]
+ current-module (lift-analysis!
+ (extension.lift
+ macro.current-module-name))
+ [value//type valueT valueV] (compile (#.Some [current-module def-name])
+ (if (macro.type? annotationsV)
+ (#.Some Type)
+ #.None)
+ valueC)]
+ (lift-analysis!
+ (do @
+ [_ (module.define def-name [value//type annotationsV valueV])]
+ (if (macro.type? annotationsV)
+ (case (macro.declared-tags annotationsV)
+ #.Nil
+ (wrap [])
+
+ tags
+ (module.declare-tags tags (macro.export? annotationsV) (:coerce Type valueV)))
+ (wrap [])))))
+
+ _
+ (///.throw bundle.invalid-syntax [extension-name]))))
+
+(def: (alias! alias def-name)
+ (-> Text Name (analysis.Operation Any))
+ (do ///.Monad<Operation>
+ [definition (extension.lift (macro.find-def def-name))]
+ (module.define alias definition)))
+
+(def: def::alias
+ Handler
+ (function (_ extension-name phase inputsC+)
+ (case inputsC+
+ (^ (list [_ (#.Identifier ["" alias])] [_ (#.Identifier def-name)]))
+ (extension.lift
+ (///.sub [(get@ [#statement.analysis #statement.state])
+ (set@ [#statement.analysis #statement.state])]
+ (alias! alias def-name)))
+
+ _
+ (///.throw bundle.invalid-syntax [extension-name]))))
+
+(do-template [<mame> <type> <scope>]
+ [(def: <mame>
+ (All [anchor expression statement]
+ (Handler anchor expression statement))
+ (function (handler extension-name phase inputsC+)
+ (case inputsC+
+ (^ (list [_ (#.Text name)] valueC))
+ (do ///.Monad<Operation>
+ [[_ handlerT handlerV] (compile #.None
+ (#.Some (:of (:share [anchor expression statement]
+ {(Handler anchor expression statement)
+ handler}
+ {<type>
+ (:assume [])})))
+ valueC)]
+ (<| <scope>
+ (extension.install name)
+ (:share [anchor expression statement]
+ {(Handler anchor expression statement)
+ handler}
+ {<type>
+ (:assume handlerV)})))
+
+ _
+ (///.throw bundle.invalid-syntax [extension-name]))))]
+
+ [def::analysis analysis.Handler lift-analysis!]
+ [def::synthesis synthesis.Handler
+ (<| extension.lift
+ (///.sub [(get@ [#statement.synthesis #statement.state])
+ (set@ [#statement.synthesis #statement.state])]))]
+ [def::translation (translation.Handler anchor expression statement)
+ (<| extension.lift
+ (///.sub [(get@ [#statement.translation #statement.state])
+ (set@ [#statement.translation #statement.state])]))]
+
+ [def::statement (Handler anchor expression statement)
+ (<|)]
+ )
+
+(def: bundle::def
+ Bundle
+ (<| (bundle.prefix "def")
+ (|> bundle.empty
+ (dictionary.put "alias" def::alias)
+ (dictionary.put "analysis" def::analysis)
+ (dictionary.put "synthesis" def::synthesis)
+ (dictionary.put "translation" def::translation)
+ (dictionary.put "statement" def::statement)
+ )))
+
+(def: #export bundle
+ Bundle
+ (<| (bundle.prefix "lux")
+ (|> bundle.empty
+ (dictionary.put "def" lux::def)
+ (dictionary.merge ..bundle::def))))
diff --git a/stdlib/source/lux/compiler/default/phase/extension/synthesis.lux b/stdlib/source/lux/compiler/default/phase/extension/synthesis.lux
index d907808a8..1a2e44f6f 100644
--- a/stdlib/source/lux/compiler/default/phase/extension/synthesis.lux
+++ b/stdlib/source/lux/compiler/default/phase/extension/synthesis.lux
@@ -1,10 +1,10 @@
(.module:
- [lux #*
- [data
- [text]
- [collection ["dict" dictionary (#+ Dictionary)]]]]
- [//])
+ [lux #*]
+ [//
+ ["." bundle]
+ [//
+ [synthesis (#+ Bundle)]]])
-(def: #export defaults
- (Dictionary Text //.Synthesis)
- (dict.new text.Hash<Text>))
+(def: #export bundle
+ Bundle
+ bundle.empty)
diff --git a/stdlib/source/lux/compiler/default/phase/extension/translation.lux b/stdlib/source/lux/compiler/default/phase/extension/translation.lux
index 3a43e0dcb..232c8c168 100644
--- a/stdlib/source/lux/compiler/default/phase/extension/translation.lux
+++ b/stdlib/source/lux/compiler/default/phase/extension/translation.lux
@@ -1,10 +1,10 @@
(.module:
- [lux #*
- [data
- [text]
- [collection ["dict" dictionary (#+ Dictionary)]]]]
- [//])
+ [lux #*]
+ [//
+ ["." bundle]
+ [//
+ [translation (#+ Bundle)]]])
-(def: #export defaults
- (Dictionary Text //.Translation)
- (dict.new text.Hash<Text>))
+(def: #export bundle
+ Bundle
+ bundle.empty)
diff --git a/stdlib/source/lux/compiler/default/phase/statement.lux b/stdlib/source/lux/compiler/default/phase/statement.lux
new file mode 100644
index 000000000..638f29b80
--- /dev/null
+++ b/stdlib/source/lux/compiler/default/phase/statement.lux
@@ -0,0 +1,55 @@
+(.module:
+ [lux #*]
+ [// (#+ Eval)
+ ["." analysis
+ [".A" expression]]
+ ["." synthesis
+ [".S" expression]]
+ ["." translation (#+ Host)]
+ ["." extension
+ ["." bundle]
+ [".E" analysis]
+ [".E" synthesis]
+ [".E" translation]
+ ## [".E" statement]
+ ]
+ [//
+ ["." init]]])
+
+(type: #export (Component state phase)
+ {#state state
+ #phase phase})
+
+(type: #export (State anchor expression statement)
+ {#analysis (Component analysis.State+
+ analysis.Phase)
+ #synthesis (Component synthesis.State+
+ synthesis.Phase)
+ #translation (Component (translation.State+ anchor expression statement)
+ (translation.Phase anchor expression statement))})
+
+(do-template [<special> <general>]
+ [(type: #export (<special> anchor expression statement)
+ (<general> (..State anchor expression statement) Code Any))]
+
+ [State+ extension.State]
+ [Operation extension.Operation]
+ [Phase extension.Phase]
+ [Handler extension.Handler]
+ [Bundle extension.Bundle]
+ )
+
+(def: #export (state eval translate host)
+ (All [anchor expression statement]
+ (-> Eval
+ (translation.Phase anchor expression statement)
+ (Host expression statement)
+ (..State+ anchor expression statement)))
+ [bundle.empty
+ ## statementE.bundle
+ {#analysis {#state [analysisE.bundle (init.compiler [])]
+ #phase (expressionA.analyser eval)}
+ #synthesis {#state [synthesisE.bundle synthesis.init]
+ #phase expressionS.synthesize}
+ #translation {#state [translationE.bundle (translation.state host)]
+ #phase translate}}])
diff --git a/stdlib/source/lux/compiler/default/phase/synthesis.lux b/stdlib/source/lux/compiler/default/phase/synthesis.lux
index 2ee018be4..29c2189c3 100644
--- a/stdlib/source/lux/compiler/default/phase/synthesis.lux
+++ b/stdlib/source/lux/compiler/default/phase/synthesis.lux
@@ -98,14 +98,16 @@
(#Control (Control Synthesis))
(#Extension (Extension Synthesis)))
-(type: #export State+
- (extension.State ..State Analysis Synthesis))
-
-(type: #export Operation
- (extension.Operation ..State Analysis Synthesis))
-
-(type: #export Phase
- (extension.Phase ..State Analysis Synthesis))
+(do-template [<special> <general>]
+ [(type: #export <special>
+ (<general> ..State Analysis Synthesis))]
+
+ [State+ extension.State]
+ [Operation extension.Operation]
+ [Phase extension.Phase]
+ [Handler extension.Handler]
+ [Bundle extension.Bundle]
+ )
(type: #export Path
(Path' Synthesis))
diff --git a/stdlib/source/lux/compiler/default/phase/translation.lux b/stdlib/source/lux/compiler/default/phase/translation.lux
index d8a58ca84..3bf09937f 100644
--- a/stdlib/source/lux/compiler/default/phase/translation.lux
+++ b/stdlib/source/lux/compiler/default/phase/translation.lux
@@ -73,20 +73,16 @@
#counter Nat
#name-cache (Dictionary Name Text)})
-(type: #export (State+ anchor expression statement)
- (extension.State (State anchor expression statement) Synthesis expression))
-
-(type: #export (Operation anchor expression statement)
- (extension.Operation (State anchor expression statement) Synthesis expression))
-
-(type: #export (Phase anchor expression statement)
- (extension.Phase (State anchor expression statement) Synthesis expression))
-
-(type: #export (Handler anchor expression statement)
- (extension.Handler (State anchor expression statement) Synthesis expression))
-
-(type: #export (Bundle anchor expression statement)
- (extension.Bundle (State anchor expression statement) Synthesis expression))
+(do-template [<special> <general>]
+ [(type: #export (<special> anchor expression statement)
+ (<general> (State anchor expression statement) Synthesis expression))]
+
+ [State+ extension.State]
+ [Operation extension.Operation]
+ [Phase extension.Phase]
+ [Handler extension.Handler]
+ [Bundle extension.Bundle]
+ )
(def: #export (state host)
(All [anchor expression statement]
diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux
index 350a0e913..702f7f342 100644
--- a/stdlib/test/tests.lux
+++ b/stdlib/test/tests.lux
@@ -42,7 +42,7 @@
[compiler
[host
[".H" scheme]]
- [default
+ ["._" default
["._" evaluation]
[phase
["._" translation
@@ -55,7 +55,9 @@
["._scheme" case]
["._scheme" extension]
["._scheme" extension/common]
- ["._scheme" expression]]]]
+ ["._scheme" expression]]]
+ [extension
+ ["._" statement]]]
["._default" cache]
[repl
["._" type]]]
@@ -65,6 +67,7 @@
["._meta_io" archive]]
["._meta" archive]
["._meta" cache]]]]
+ ## TODO: Must have 100% coverage on tests.
[test
["_." lux]
[lux
@@ -104,7 +107,7 @@
["_." product]
["_." sum]
[number
- ## "_." number ## TODO: Specially troublesome...
+ ## "_." number ## TODO: FIX Specially troublesome...
["_." i64]
["_." ratio]
["_." complex]]
@@ -145,7 +148,7 @@
["poly_." functor]]]
["_." type
["_." check]
- ## ["_." implicit] ## TODO: Specially troublesome...
+ ## ["_." implicit] ## TODO: FIX Specially troublesome...
["_." resource]]
[compiler
[default
@@ -166,7 +169,7 @@
["_.S" function]]]]]
[world
["_." binary]
- ## ["_." file] ## TODO: Specially troublesome...
+ ## ["_." file] ## TODO: FIX Specially troublesome...
[net
["_." tcp]
["_." udp]]]]]