Moved statement phase into stdlib.

13 files changed, 330 insertions, 67 deletions

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]]]]]