- Added analysis, synthesis, translation and statement extensions.

- No longer doing ad-hoc I/O in new-luxc.
- Minor fixes and adjustments.

9 files changed, 336 insertions, 99 deletions

diff --git a/new-luxc/source/luxc/lang/extension.lux b/new-luxc/source/luxc/lang/extension.lux
new file mode 100644
index 000000000..d38d564fb
--- /dev/null
+++ b/new-luxc/source/luxc/lang/extension.lux
@@ -0,0 +1,84 @@
+(.module:
+  lux
+  (lux (control [monad #+ do]
+                ["ex" exception #+ exception:])
+       (data ["e" error]
+             [text]
+             (coll [dict #+ Dict]))
+       [macro])
+  [//])
+
+(exception: #export Unknown-Analysis)
+(exception: #export Unknown-Synthesis)
+(exception: #export Unknown-Translation)
+(exception: #export Unknown-Statement)
+
+(exception: #export Cannot-Define-Analysis-More-Than-Once)
+(exception: #export Cannot-Define-Synthesis-More-Than-Once)
+(exception: #export Cannot-Define-Translation-More-Than-Once)
+(exception: #export Cannot-Define-Statement-More-Than-Once)
+
+(type: #export Expression
+  (-> (List Code) (Meta Code)))
+
+(type: #export Statement
+  (-> (List Code) (Meta Unit)))
+
+(type: #export Extensions
+  {#analysis (Dict Text Expression)
+   #synthesis (Dict Text Expression)
+   #translation (Dict Text Expression)
+   #statement (Dict Text Statement)})
+
+(def: #export fresh
+  Extensions
+  {#analysis (dict.new text.Hash<Text>)
+   #synthesis (dict.new text.Hash<Text>)
+   #translation (dict.new text.Hash<Text>)
+   #statement (dict.new text.Hash<Text>)})
+
+(def: get
+  (Meta Extensions)
+  (function [compiler]
+    (#e.Success [compiler
+                 (|> compiler (get@ #.extensions) (:! Extensions))])))
+
+(def: (set extensions)
+  (-> Extensions (Meta Unit))
+  (function [compiler]
+    (#e.Success [(set@ #.extensions (:! Void extensions) compiler)
+                 []])))
+
+(do-template [<name> <type> <category> <exception>]
+  [(def: #export (<name> name)
+     (-> Text (Meta <type>))
+     (do macro.Monad<Meta>
+       [extensions ..get]
+       (case (dict.get name (get@ <category> extensions))
+         (#.Some extension)
+         (wrap extension)
+
+         #.None
+         (//.throw <exception> name))))]
+
+  [find-analysis    Expression #analysis    Unknown-Analysis]
+  [find-synthesis   Expression #synthesis   Unknown-Synthesis]
+  [find-translation Expression #translation Unknown-Translation]
+  [find-statement   Statement  #statement   Unknown-Statement]
+  )
+
+(do-template [<name> <type> <category> <exception>]
+  [(def: #export (<name> name extension)
+     (-> Text <type> (Meta Unit))
+     (do macro.Monad<Meta>
+       [extensions ..get
+        _ (//.assert <exception> name
+                     (not (dict.contains? name (get@ <category> extensions))))
+        _ (..set (update@ <category> (dict.put name extension) extensions))]
+       (wrap [])))]
+
+  [install-analysis    Expression #analysis    Cannot-Define-Analysis-More-Than-Once]
+  [install-synthesis   Expression #synthesis   Cannot-Define-Synthesis-More-Than-Once]
+  [install-translation Expression #translation Cannot-Define-Translation-More-Than-Once]
+  [install-statement   Statement  #statement   Cannot-Define-Statement-More-Than-Once]
+  )
diff --git a/new-luxc/source/luxc/lang/extension/analysis.lux b/new-luxc/source/luxc/lang/extension/analysis.lux
new file mode 100644
index 000000000..d034f2919
--- /dev/null
+++ b/new-luxc/source/luxc/lang/extension/analysis.lux
@@ -0,0 +1,9 @@
+(.module:
+  lux
+  (lux (data [text]
+             (coll [dict #+ Dict])))
+  [//])
+
+(def: #export defaults
+  (Dict Text //.Expression)
+  (dict.new text.Hash<Text>))
diff --git a/new-luxc/source/luxc/lang/extension/statement.lux b/new-luxc/source/luxc/lang/extension/statement.lux
new file mode 100644
index 000000000..6e9530f38
--- /dev/null
+++ b/new-luxc/source/luxc/lang/extension/statement.lux
@@ -0,0 +1,146 @@
+(.module:
+  lux
+  (lux (control [monad #+ do]
+                ["ex" exception #+ exception:])
+       (data [text]
+             text/format
+             (coll [list "list/" Functor<List>]
+                   [dict #+ Dict]))
+       [macro]
+       (lang (type ["tc" check]))
+       [io #+ IO])
+  [//]
+  (luxc [lang]
+        (lang [".L" host]
+              (host ["$" jvm])
+              (analysis [".A" common]
+                        [".A" expression])
+              (synthesis [".S" expression])
+              (translation [".T" expression]
+                           [".T" statement]
+                           [".T" eval])
+              [".L" eval])))
+
+(exception: #export Invalid-Statement)
+(exception: #export 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 annsC)
+  (-> 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 annsA))
+     annsV (evalT.eval annsI)]
+    (wrap [annsI (:! Code annsV)])))
+
+(def: (ensure-valid-alias def-name annotations value)
+  (-> Text Code Code (Meta Unit))
+  (case [annotations value]
+    (^multi [[_ (#.Record pairs)] [_ (#.Symbol _)]]
+            (|> 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 [_ (#.Symbol ["" def-name])] valueC annotationsC))
+      (hostL.with-context def-name
+        (lang.with-fresh-type-env
+          (do macro.Monad<Meta>
+            [[annotationsI annotationsV] (process-annotations annotationsC)]
+            (case (macro.get-symbol-ann (ident-for #.alias) annotationsV)
+              (#.Some real-def)
+              (do @
+                [_ (ensure-valid-alias def-name annotationsV valueC)
+                 _ (lang.with-scope
+                     (statementT.translate-def def-name Void id annotationsI annotationsV))]
+                (wrap []))
+
+              #.None
+              (do @
+                [[_ valueT valueA] (lang.with-scope
+                                     (if (macro.type? (:! 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 valueA))
+                 _ (lang.with-scope
+                     (statementT.translate-def def-name valueT valueI annotationsI annotationsV))]
+                (wrap []))))))
+
+      _
+      (throw-invalid-statement procedure inputsC+))))
+
+(def: (lux//program procedure)
+  (-> Text //.Statement)
+  (function [inputsC+]
+    (case inputsC+
+      (^ (list [_ (#.Symbol ["" args])] programC))
+      (do macro.Monad<Meta>
+        [[_ programA] (lang.with-scope
+                        (lang.with-type (type (IO Unit))
+                          (expressionA.analyser evalL.eval programC)))
+         programI (expressionT.translate (expressionS.synthesize programA))
+         _ (statementT.translate-program args 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)))
+            valueI (expressionT.translate (expressionS.synthesize valueA))
+            valueV (evalT.eval valueI)
+            _ (<installer> name (:! <type> valueV))]
+           (wrap []))
+
+         _
+         (throw-invalid-statement procedure inputsC+))))]
+
+  [lux//analysis    //.Expression //.install-analysis]
+  [lux//synthesis   //.Expression //.install-synthesis]
+  [lux//translation //.Expression //.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/extension/synthesis.lux b/new-luxc/source/luxc/lang/extension/synthesis.lux
new file mode 100644
index 000000000..d034f2919
--- /dev/null
+++ b/new-luxc/source/luxc/lang/extension/synthesis.lux
@@ -0,0 +1,9 @@
+(.module:
+  lux
+  (lux (data [text]
+             (coll [dict #+ Dict])))
+  [//])
+
+(def: #export defaults
+  (Dict Text //.Expression)
+  (dict.new text.Hash<Text>))
diff --git a/new-luxc/source/luxc/lang/extension/translation.lux b/new-luxc/source/luxc/lang/extension/translation.lux
new file mode 100644
index 000000000..d034f2919
--- /dev/null
+++ b/new-luxc/source/luxc/lang/extension/translation.lux
@@ -0,0 +1,9 @@
+(.module:
+  lux
+  (lux (data [text]
+             (coll [dict #+ Dict])))
+  [//])
+
+(def: #export defaults
+  (Dict Text //.Expression)
+  (dict.new text.Hash<Text>))
diff --git a/new-luxc/source/luxc/lang/host/jvm.lux b/new-luxc/source/luxc/lang/host/jvm.lux
index cfe71656c..67b28b7b0 100644
--- a/new-luxc/source/luxc/lang/host/jvm.lux
+++ b/new-luxc/source/luxc/lang/host/jvm.lux
@@ -1,5 +1,5 @@
 (.module:
-  [lux #- Type Def]
+  [lux #- Type]
   (lux (control monad
                 ["p" parser])
        (data (coll [list "list/" Functor<List>]))
diff --git a/new-luxc/source/luxc/lang/module.lux b/new-luxc/source/luxc/lang/module.lux
index 58bf94571..ebc0ee7b0 100644
--- a/new-luxc/source/luxc/lang/module.lux
+++ b/new-luxc/source/luxc/lang/module.lux
@@ -25,7 +25,7 @@
   (-> Nat Module)
   {#.module-hash        hash
    #.module-aliases     (list)
-   #.defs               (list)
+   #.definitions        (list)
    #.imports            (list)
    #.tags               (list)
    #.types              (list)
@@ -82,16 +82,16 @@
 
 (def: #export (define (^@ full-name [module-name def-name])
                       definition)
-  (-> Ident Def (Meta Unit))
+  (-> Ident Definition (Meta Unit))
   (function [compiler]
     (case (&.pl-get module-name (get@ #.modules compiler))
       (#.Some module)
-      (case (&.pl-get def-name (get@ #.defs module))
+      (case (&.pl-get def-name (get@ #.definitions module))
         #.None
         (#e.Success [(update@ #.modules
                               (&.pl-put module-name
-                                        (update@ #.defs
-                                                 (: (-> (List [Text Def]) (List [Text Def]))
+                                        (update@ #.definitions
+                                                 (: (-> (List [Text Definition]) (List [Text Definition]))
                                                     (|>> (#.Cons [def-name definition])))
                                                  module))
                               compiler)
diff --git a/new-luxc/source/luxc/lang/translation.lux b/new-luxc/source/luxc/lang/translation.lux
index 6cba6cc35..a0e5bca97 100644
--- a/new-luxc/source/luxc/lang/translation.lux
+++ b/new-luxc/source/luxc/lang/translation.lux
@@ -20,17 +20,24 @@
         (lang [".L" module]
               [".L" host]
               [".L" macro]
+              [".L" extension]
+              (extension [".E" analysis]
+                         [".E" synthesis]
+                         [".E" translation]
+                         [".E" statement])
               (host ["$" jvm])
               (analysis [".A" expression]
                         [".A" common])
               (synthesis [".S" expression])
               (translation [".T" runtime]
                            [".T" statement]
-                           [".T" common]
+                           [".T" common #+ Artifacts]
                            [".T" expression]
                            [".T" eval]
                            [".T" imports])
-              ["&." eval])
+              ["&." eval]
+              ## [".L" cache]
+              )
         ))
 
 (def: analyse
@@ -39,7 +46,6 @@
 
 (exception: #export Macro-Expansion-Failed)
 (exception: #export Unrecognized-Statement)
-(exception: #export Invalid-Alias)
 (exception: #export Invalid-Macro)
 
 (def: (process-annotations annsC)
@@ -60,55 +66,9 @@
        (wrap (|> this (get@ #.module-aliases) (dict.from-list text.Hash<Text>) (: Aliases))))
      new-compiler)))
 
-(def: (ensure-valid-alias def-name annotations value)
-  (-> Text Code Code (Meta Unit))
-  (case [annotations value]
-    (^multi [[_ (#.Record pairs)] [_ (#.Symbol _)]]
-            (|> pairs list.size (n/= +1)))
-    (:: macro.Monad<Meta> wrap [])
-
-    _
-    (&.throw Invalid-Alias def-name)))
-
 (def: #export (translate translate-module aliases code)
   (-> (-> Text Compiler (Process Compiler)) Aliases Code (Meta Aliases))
   (case code
-    (^code ("lux def" (~ [_ (#.Symbol ["" def-name])]) (~ valueC) (~ annsC)))
-    (hostL.with-context def-name
-      (&.with-fresh-type-env
-        (do macro.Monad<Meta>
-          [[annsI annsV] (process-annotations annsC)]
-          (case (macro.get-symbol-ann (ident-for #.alias) annsV)
-            (#.Some real-def)
-            (do @
-              [_ (ensure-valid-alias def-name annsV valueC)
-               _ (&.with-scope
-                   (statementT.translate-def def-name Void id annsI annsV))]
-              (wrap aliases))
-
-            #.None
-            (do @
-              [[_ valueT valueA] (&.with-scope
-                                   (if (macro.type? (:! Code annsV))
-                                     (do @
-                                       [valueA (&.with-type Type
-                                                 (analyse valueC))]
-                                       (wrap [Type valueA]))
-                                     (commonA.with-unknown-type
-                                       (analyse valueC))))
-               valueT (&.with-type-env
-                        (tc.clean valueT))
-               ## #let [_ (if (or (text/= "string~" def-name))
-               ##           (log! (format "{" def-name "}\n"
-               ##                         "     TYPE: " (%type valueT) "\n"
-               ##                         " ANALYSIS: " (%code valueA) "\n"
-               ##                         "SYNTHESIS: " (%code (expressionS.synthesize valueA))))
-               ##           [])]
-               valueI (expressionT.translate (expressionS.synthesize valueA))
-               _ (&.with-scope
-                   (statementT.translate-def def-name valueT valueI annsI annsV))]
-              (wrap aliases))))))
-
     (^code ("lux module" (~ annsC)))
     (do macro.Monad<Meta>
       [[annsI annsV] (process-annotations annsC)
@@ -120,15 +80,12 @@
         (#e.Error error)
         (macro.fail error)))
 
-    (^code ("lux program" (~ [_ (#.Symbol ["" program-args])]) (~ programC)))
+    (^code ((~ [_ (#.Text statement)]) (~+ argsC+)))
     (do macro.Monad<Meta>
-      [[_ programA] (&.with-scope
-                      (&.with-type (type (io.IO Unit))
-                        (analyse programC)))
-       programI (expressionT.translate (expressionS.synthesize programA))
-       _ (statementT.translate-program program-args programI)]
+      [statement (extensionL.find-statement statement)
+       _ (statement argsC+)]
       (wrap aliases))
-
+    
     (^code ((~ macroC) (~+ argsC+)))
     (do macro.Monad<Meta>
       [[_ macroA] (&.with-scope
@@ -199,6 +156,22 @@
       (#e.Success [(set@ #.source source' compiler)
                    output]))))
 
+(def: (write-module target-dir module-name module artifacts)
+  (-> File Text Module Artifacts (Process Unit))
+  (do io.Monad<Process>
+    [_ (monad.map @ (function [[name content]]
+                      (&io.write target-dir
+                                 (format module-name "/" name (for {"JVM" ".class"
+                                                                    "JS" ".js"}))
+                                 content))
+                  (dict.entries artifacts))]
+    (wrap [])
+    ## (&io.write (format module-dir "/" cacheL.descriptor-name)
+    ##            (text-to-blob (%code (cacheL.describe module))))
+    ))
+
+(def: no-aliases Aliases (dict.new text.Hash<Text>))
+
 (def: #export (translate-module source-dirs target-dir module-name compiler)
   (-> (List File) File Text Compiler (Process Compiler))
   (do io.Monad<Process>
@@ -208,26 +181,23 @@
            translate-module (translate-module source-dirs target-dir)]]
     (case (macro.run' compiler
                       (do macro.Monad<Meta>
-                        [[_ artifacts _] (moduleL.with-module module-hash module-name
-                                           (commonT.with-artifacts
-                                             (with-active-compilation [module-name
-                                                                       file-name
-                                                                       file-content]
-                                               (forgive-eof
-                                                (loop [aliases (: Aliases
-                                                                  (dict.new text.Hash<Text>))]
-                                                  (do @
-                                                    [code (read module-name aliases)
-                                                     #let [[cursor _] code]
-                                                     aliases' (&.with-cursor cursor
-                                                                (translate translate-module aliases code))]
-                                                    (forgive-eof (recur aliases'))))))))]
-                        (wrap artifacts)))
-      (#e.Success [compiler artifacts])
+                        [[module artifacts _] (moduleL.with-module module-hash module-name
+                                                (commonT.with-artifacts
+                                                  (with-active-compilation [module-name
+                                                                            file-name
+                                                                            file-content]
+                                                    (forgive-eof
+                                                     (loop [aliases no-aliases]
+                                                       (do @
+                                                         [code (read module-name aliases)
+                                                          #let [[cursor _] code]
+                                                          aliases' (&.with-cursor cursor
+                                                                     (translate translate-module aliases code))]
+                                                         (forgive-eof (recur aliases'))))))))]
+                        (wrap [module artifacts])))
+      (#e.Success [compiler [module artifacts]])
       (do @
-        [## _ (monad.map @ (function [[class-name class-bytecode]]
-         ##                  (&io.write-file target-dir class-name class-bytecode))
-         ##              (dict.entries artifacts))
+        [## _ (write-module target-dir module-name module artifacts)
          ]
         (wrap compiler))
       
@@ -253,7 +223,7 @@
   (-> commonT.Host Compiler)
   {#.info            init-info
    #.source          [init-cursor +0 ""]
-   #.cursor          init-cursor
+   #.cursor          .dummy-cursor
    #.current-module  #.None
    #.modules         (list)
    #.scopes          (list)
@@ -261,23 +231,35 @@
    #.expected        #.None
    #.seed            +0
    #.scope-type-vars (list)
+   #.extensions      (:! Void extensionL.fresh)
    #.host            (:! Void host)})
 
-(def: #export (translate-program sources target program)
-  (-> (List File) File Text (T.Task Unit))
-  (do T.Monad<Task>
-    [compiler (|> (case (runtimeT.translate (init-compiler (io.run hostL.init-host)))
-                    (#e.Error error)
-                    (T.fail error)
+(def: (initialize sources target)
+  (-> (List File) File (Process Compiler))
+  (do io.Monad<Process>
+    [compiler (: (Process Compiler)
+                 (case (runtimeT.translate (init-compiler (io.run hostL.init-host)))
+                   (#e.Error error)
+                   (io.fail error)
 
-                    (#e.Success [compiler [runtime-bc function-bc]])
-                    (do @
-                      [_ (&io.prepare-target target)
-                       _ (&io.write-file target (format hostL.runtime-class ".class") runtime-bc)
-                       _ (&io.write-file target (format hostL.function-class ".class") function-bc)]
-                      (wrap compiler)))
-                  (: (T.Task Compiler))
-                  (:: @ map (|>> (translate-module sources target prelude) P.future)) (:: @ join)
-                  (:: @ map (|>> (translate-module sources target program) P.future)) (:: @ join))
+                   (#e.Success [compiler [runtime-bc function-bc]])
+                   (do @
+                     [_ (&io.prepare-target target)
+                      _ (&io.write target (format hostL.runtime-class ".class") runtime-bc)
+                      _ (&io.write target (format hostL.function-class ".class") function-bc)]
+                     (wrap (set@ #.extensions
+                                 (:! Void
+                                     {#extensionL.analysis analysisE.defaults
+                                      #extensionL.synthesis synthesisE.defaults
+                                      #extensionL.translation translationE.defaults
+                                      #extensionL.statement statementE.defaults})
+                                 compiler)))))]
+    (translate-module sources target prelude compiler)))
+
+(def: #export (translate-program sources target program)
+  (-> (List File) File Text (Process Unit))
+  (do io.Monad<Process>
+    [compiler (initialize sources target)
+     _ (translate-module sources target program compiler)
      #let [_ (log! "Compilation complete!")]]
     (wrap [])))
diff --git a/new-luxc/source/luxc/lang/translation/common.jvm.lux b/new-luxc/source/luxc/lang/translation/common.jvm.lux
index b75b0672b..1132928d0 100644
--- a/new-luxc/source/luxc/lang/translation/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/common.jvm.lux
@@ -98,7 +98,5 @@
         (#e.Success [compiler (ClassLoader::loadClass [name] (get@ #loader host))])
         (ex.throw Unknown-Class name)))))
 
-## (def: #export bytecode-version Int Opcodes::V1_6)
-
 (def: #export value-field Text "_value")
 (def: #export $Object $.Type ($t.class "java.lang.Object" (list)))