Moved statement phase into stdlib.

2 files changed, 1 insertions, 228 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