- WIP: Some initial implementations for some re-written infrastructure.

17 files changed, 1109 insertions, 70 deletions

diff --git a/new-luxc/source/luxc/analyser.lux b/new-luxc/source/luxc/analyser.lux
new file mode 100644
index 000000000..84719738e
--- /dev/null
+++ b/new-luxc/source/luxc/analyser.lux
@@ -0,0 +1,368 @@
+(;module:
+  lux
+  (lux (control monad
+                pipe)
+       [io #- run]
+       (concurrency ["A" atom])
+       (data ["E" error]
+             [text "T/" Eq<Text>]
+             text/format
+             (coll [list "L/" Fold<List> Monoid<List> Monad<List>]
+                   ["D" dict])
+             [number]
+             [product])
+       [macro #+ Monad<Lux>]
+       [type]
+       (type ["TC" check]))
+  (luxc ["&" base]
+        ["&;" module]
+        ["&;" env]
+        (module ["&;" def])))
+
+(type: #export Pattern Void)
+
+(type: #export (Analysis' Analysis)
+  (#Bool Bool)
+  (#Nat Nat)
+  (#Int Int)
+  (#Deg Deg)
+  (#Real Real)
+  (#Char Char)
+  (#Text Text)
+  (#Variant Nat Bool Analysis)
+  #Unit
+  (#Tuple (List Analysis))
+  (#Call Analysis (List Analysis))
+  (#Case (List [Pattern Analysis]))
+  (#Function Scope Analysis)
+  (#Var Ref)
+  (#Def Ident)
+  (#Procedure Text (List Analysis))
+  )
+
+(type: #export #rec Analysis
+  (Meta [Type Cursor]
+        (Analysis' Analysis)))
+
+(def: (with-expected-type expected action)
+  (All [a] (-> Type (Lux a) (Lux a)))
+  (function [compiler]
+    (case (action (set@ #;expected (#;Some expected) compiler))
+      (#E;Success [compiler' output])
+      (let [old-expected (get@ #;expected compiler)]
+        (#E;Success [(set@ #;expected old-expected compiler')
+                     output]))
+
+      (#E;Error error)
+      (#E;Error error))))
+
+(def: (analyse-typed-tuple analyse cursor members)
+  (-> (-> AST (Lux Analysis)) Cursor
+      (List AST)
+      (Lux Analysis))
+  (do Monad<Lux>
+    [expected macro;expected-type]
+    (let [member-types (type;flatten-tuple expected)
+          num-types (list;size member-types)
+          num-members (list;size members)]
+      (cond (n.= num-types num-members)
+            (do @
+              [=tuple (: (Lux (List Analysis))
+                         (mapM @
+                               (function [[expected member]]
+                                 (with-expected-type expected
+                                   (analyse member)))
+                               (list;zip2 member-types members)))]
+              (wrap [[expected cursor]
+                     (#Tuple =tuple)]))
+
+            (n.< num-types num-members)
+            (do @
+              [#let [[head-ts tail-ts] (list;split (n.- +2 num-members)
+                                                   member-types)]
+               =prevs (mapM @
+                            (function [[expected member]]
+                              (with-expected-type expected
+                                (analyse member)))
+                            (list;zip2 head-ts members))
+               =last (with-expected-type (type;tuple tail-ts)
+                       (analyse (default (undefined)
+                                  (list;last members))))]
+              (wrap [[expected cursor]
+                     (#Tuple (L/append =prevs (list =last)))]))
+
+            ## (n.> num-types num-members)
+            (do @
+              [#let [[head-xs tail-xs] (list;split (n.- +2 num-types)
+                                                   members)]
+               =prevs (mapM @
+                            (function [[expected member]]
+                              (with-expected-type expected
+                                (analyse member)))
+                            (list;zip2 member-types head-xs))
+               =last (with-expected-type (default (undefined)
+                                           (list;last member-types))
+                       (analyse-typed-tuple analyse cursor tail-xs))]
+              (wrap [[expected cursor]
+                     (#Tuple (L/append =prevs (list =last)))]))
+            ))))
+
+(def: (within-type-env action)
+  (All [a] (-> (TC;Check a) (Lux a)))
+  (function [compiler]
+    (case (action (get@ #;type-context compiler))
+      (#E;Error error)
+      (#E;Error error)
+
+      (#E;Success [context' output])
+      (#E;Success [(set@ #;type-context context' compiler)
+                   output]))))
+
+(def: get-type
+  (-> Analysis Type)
+  (|>. product;left
+       product;left))
+
+(def: (replace-type replacement analysis)
+  (-> Type Analysis Analysis)
+  (let [[[_type _cursor] _analysis] analysis]
+    (: Analysis
+       [[(: Type replacement)
+         (: Cursor _cursor)]
+        (: (Analysis' Analysis)
+           _analysis)])))
+
+(def: (clean-analysis type analysis)
+  (-> Type Analysis (Lux Analysis))
+  (case type
+    (#;VarT id)
+    (do Monad<Lux>
+      [=type (within-type-env
+              (TC;clean id type))]
+      (wrap (replace-type =type analysis)))
+    
+    (#;ExT id)
+    (undefined)
+    
+    _
+    (&;fail (format "Cannot clean type: " (%type type)))))
+
+(def: (with-unknown-type action)
+  (All [a] (-> (Lux Analysis) (Lux Analysis)))
+  (do Monad<Lux>
+    [[var-id var-type] (within-type-env
+                        TC;create-var)
+     analysis (|> (wrap action)
+                  (%> @
+                      [(with-expected-type var-type)]
+                      [(clean-analysis var-type)]))
+     _ (within-type-env
+        (TC;delete-var var-id))]
+    (wrap analysis)))
+
+(def: (tuple cursor members)
+  (-> Cursor (List Analysis) Analysis)
+  (let [tuple-type (type;tuple (L/map get-type members))]
+    [[tuple-type cursor]
+     (#Tuple members)]))
+
+(def: (realize expected)
+  (-> Type (TC;Check [(List Type) Type]))
+  (case expected
+    (#;NamedT [module name] _expected)
+    (realize _expected)
+
+    (#;UnivQ env body)
+    (do TC;Monad<Check>
+      [[var-id var-type] TC;create-var
+       [tail =expected] (realize (default (undefined)
+                                   (type;apply-type expected var-type)))]
+      (wrap [(list& var-type tail)
+             =expected]))
+
+    (#;ExQ env body)
+    (do TC;Monad<Check>
+      [[ex-id ex-type] TC;existential
+       [tail =expected] (realize (default (undefined)
+                                   (type;apply-type expected ex-type)))]
+      (wrap [(list& ex-type tail)
+             =expected]))
+
+    _
+    (:: TC;Monad<Check> wrap [(list) expected])))
+
+(def: (analyse-tuple analyse cursor members)
+  (-> (-> AST (Lux Analysis)) Cursor
+      (List AST)
+      (Lux Analysis))
+  (do Monad<Lux>
+    [expected macro;expected-type]
+    (case expected
+      (#;ProdT _)
+      (analyse-typed-tuple analyse cursor members)
+
+      (#;VarT id)
+      (do @
+        [bound? (within-type-env
+                 (TC;bound? id))]
+        (if bound?
+          (do @
+            [expected' (within-type-env
+                        (TC;read-var id))
+             =tuple (with-expected-type expected'
+                      (analyse-tuple analyse cursor members))]
+            (wrap (replace-type expected =tuple)))
+          (do @
+            [=members (mapM @ (<|. with-unknown-type
+                                   analyse)
+                            members)
+             #let [=tuple (tuple cursor =members)]
+             _ (within-type-env
+                (TC;check expected (get-type =tuple)))]
+            (wrap (replace-type expected =tuple)))))
+
+      _
+      (if (type;quantified? expected)
+        (do @
+          [[bindings expected'] (within-type-env
+                                 (realize expected))
+           =tuple (with-expected-type expected'
+                    (analyse-tuple analyse cursor members))
+           =tuple (foldM @ clean-analysis =tuple bindings)
+           _ (within-type-env
+              (TC;check expected (get-type =tuple)))]
+          (wrap (replace-type expected =tuple)))
+        (&;fail (format "Invalid type for tuple: " (%type expected))))
+      )))
+
+(def: (analyse-variant analyse cursor tag value)
+  (-> (-> AST (Lux Analysis)) Cursor
+      Nat AST
+      (Lux Analysis))
+  (do Monad<Lux>
+    [expected macro;expected-type]
+    (case expected
+      (#;SumT _)
+      (let [flat (type;flatten-variant expected)
+            type-size (list;size flat)]
+        (if (n.< type-size tag)
+          (do @
+            [#let [last? (n.= tag (n.dec type-size))
+                   variant-type (default (undefined)
+                                  (list;nth tag flat))]
+             =value (with-expected-type variant-type
+                      (analyse value))]
+            (wrap [[expected cursor]
+                   (#Variant tag last? =value)]))
+          (&;fail (format "Trying to create variant with tag beyond type's limitations." "\n"
+                          "Tag: " (%n tag) "\n"
+                          "Type size: " (%n type-size) "\n"
+                          "Type: " (%type expected) "\n"))))
+
+      _
+      (if (type;quantified? expected)
+        (do @
+          [[bindings expected'] (within-type-env
+                                 (realize expected))
+           =variant (with-expected-type expected'
+                      (analyse-variant analyse cursor tag value))
+           =variant (foldM @ clean-analysis =variant bindings)
+           _ (within-type-env
+              (TC;check expected (get-type =variant)))]
+          (wrap (replace-type expected =variant)))
+        (&;fail (format "Invalid type for variant: " (%type expected)))))))
+
+(def: (analyse eval ast)
+  (-> (-> Type AST (Lux Top)) AST (Lux Analysis))
+  (do Monad<Lux>
+    []
+    (case ast
+      (^template [<ast-tag> <analysis-tag> <type>]
+        [cursor (<ast-tag> value)]
+        (do @
+          [expected macro;expected-type
+           _ (within-type-env
+              (TC;check expected <type>))]
+          (wrap [[<type> cursor]
+                 (<analysis-tag> value)])))
+      ([#;BoolS #Bool Bool]
+       [#;NatS  #Nat  Nat]
+       [#;IntS  #Int  Int]
+       [#;DegS  #Deg  Deg]
+       [#;RealS #Real Real]
+       [#;CharS #Char Char]
+       [#;TextS #Text Text])
+
+      (^ [cursor (#;TupleS (list))])
+      (do @
+        [expected macro;expected-type
+         _ (within-type-env
+            (TC;check expected Unit))]
+        (wrap [[Unit cursor]
+               #Unit]))
+
+      (^ [cursor (#;TupleS (list singleton))])
+      (analyse eval singleton)
+
+      (^ [cursor (#;TupleS elems)])
+      (do @
+        [expected macro;expected-type]
+        (with-expected-type expected
+          (analyse-tuple (analyse eval) cursor elems)))
+
+      [cursor (#;SymbolS ["" local-name])]
+      (do @
+        [?local (&env;find local-name)]
+        (case ?local
+          (#;Some [actual index])
+          (do @
+            [expected macro;expected-type
+             _ (within-type-env
+                (TC;check expected actual))]
+            (wrap [[expected cursor]
+                   (#Var index)]))
+
+          #;None
+          (do @
+            [this-module macro;current-module-name]
+            (analyse eval [cursor (#;SymbolS [this-module local-name])]))))
+
+      [cursor (#;SymbolS def-name)]
+      (do @
+        [expected macro;expected-type
+         actual (&def;find def-name)
+         _ (within-type-env
+            (TC;check expected actual))]
+        (wrap [[expected cursor]
+               (#Def def-name)]))
+
+      (^ [cursor (#;FormS (list [_ (#;SymbolS ["" "_lux_check"])]
+                                type
+                                value))])
+      (do @
+        [expected macro;expected-type
+         actual (eval Type type)
+         _ (within-type-env
+            (TC;check expected actual))]
+        (with-expected-type actual
+          (analyse eval value)))
+
+      (^ [cursor (#;FormS (list [_ (#;SymbolS ["" "_lux_coerce"])]
+                                type
+                                value))])
+      (do @
+        [expected macro;expected-type
+         actual (eval Type type)
+         _ (within-type-env
+            (TC;check expected actual))
+         =value (with-expected-type Top
+                  (analyse eval value))]
+        (wrap (replace-type actual =value)))
+
+      (^ [cursor (#;FormS (list [_ (#;NatS tag)]
+                                value))])
+      (analyse-variant (analyse eval) cursor tag value)
+
+      _
+      (&;fail (format "Unrecognized syntax: " (%ast ast)))
+      )))
diff --git a/new-luxc/source/luxc/base.lux b/new-luxc/source/luxc/base.lux
new file mode 100644
index 000000000..ce872e9da
--- /dev/null
+++ b/new-luxc/source/luxc/base.lux
@@ -0,0 +1,21 @@
+(;module:
+  lux
+  (lux (control monad)
+       (data text/format)
+       [macro #+ Monad<Lux>]))
+
+(type: #export Path Text)
+
+(type: #export Mode
+  #Release
+  #Debug)
+
+(def: #export (fail message)
+  (All [a] (-> Text (Lux a)))
+  (do Monad<Lux>
+    [[file line col] macro;cursor
+     #let [location (format file
+                            "," (|> line nat-to-int %i)
+                            "," (|> col nat-to-int %i))]]
+    (macro;fail (format "@ " location
+                        "\n" message))))
diff --git a/new-luxc/source/luxc/compiler.lux b/new-luxc/source/luxc/compiler.lux
new file mode 100644
index 000000000..205c62df0
--- /dev/null
+++ b/new-luxc/source/luxc/compiler.lux
@@ -0,0 +1,95 @@
+(;module:
+  lux
+  (lux (control monad)
+       [io #- run]
+       (data ["E" error]
+             [text "T/" Eq<Text>]
+             text/format)
+       [macro #+ Monad<Lux>])
+  (luxc ["&" base]
+        ["&;" io]
+        ["&;" module]
+        (compiler ["&&;" runtime]
+                  ["&&;" statement])
+        ))
+
+(def: (compile ast)
+  (-> AST (Lux Unit))
+  (case ast
+    (^ [_ (#;FormS (list [_ (#;SymbolS ["" "_lux_def"])]
+                         [_ (#;SymbolS ["" def-name])]
+                         def-value
+                         def-meta))])
+    (&&statement;compile-def def-name def-value def-meta)
+
+    (^ [_ (#;FormS (list [_ (#;SymbolS ["" "_lux_program"])]
+                         [_ (#;SymbolS ["" prog-args])]
+                         prog-body))])
+    (&&statement;compile-program prog-args prog-body)
+
+    _
+    (&;fail (format "Unrecognized statement: " (%ast ast)))))
+
+(def: (exhaust action)
+  (All [a] (-> (Lux a) (Lux Unit)))
+  (do Monad<Lux>
+    [result action]
+    (exhaust action)))
+
+(def: (compile-module source-dirs module-name compiler-state)
+  (-> (List &;Path) Text Compiler (IO (Error Compiler)))
+  (do Monad<IO>
+    [[file-name file-content] (&io;read-module source-dirs module-name)
+     #let [file-hash (T/hash file-content)]
+     #let [result (macro;run compiler-state
+                             (do Monad<Lux>
+                               [module-exists? (&module;exists? module-name)]
+                               (if module-exists?
+                                 (&;fail (format "Cannot re-define a module: " module-name))
+                                 (wrap []))))]]
+    (case result
+      (#E;Success [compiler-state _])
+      (let [result (macro;run compiler-state
+                              (do Monad<Lux>
+                                [_ (&module;create module-name file-hash)
+                                 _ (&module;flag-active module-name)
+                                 _ (if (T/= "lux" module-name)
+                                     &&runtime;compile-runtime
+                                     (wrap []))
+                                 _ (exhaust
+                                    (do @
+                                      [ast parse]
+                                      (compile ast)))
+                                 _ (&module;flag-compiled module-name)]
+                                (&module;generate-module file-hash module-name)))]
+        (case result
+          (#E;Success [compiler-state module-descriptor])
+          (do @
+            [_ (&io;write-module module-name module-descriptor)]
+            (wrap (#E;Success compiler-state)))
+
+          (#E;Error error)
+          (wrap (#E;Error error))))
+      
+      (#E;Error error)
+      (wrap (#E;Error error)))))
+
+(def: (or-crash! action)
+  (All [a] (-> (IO (E;Error a)) (IO a)))
+  (do Monad<IO>
+    [result action]
+    (case result
+      (#E;Success output)
+      (wrap output)
+
+      (#E;Error error)
+      (error! (format "Compilation failed:\n" error)))))
+
+(def: #export (compile-program mode program target sources)
+  (-> &;Mode &;Path &;Path (List &;Path) (IO Unit))
+  (do Monad<IO>
+    [#let [compiler-state (init-compiler-state mode host-state)]
+     compiler-state (or-crash! (compile-module source-dirs "lux" compiler-state))
+     compiler-state (or-crash! (compile-module source-dirs program compiler-state))
+     #let [_ (log! "Compilation complete!")]]
+    (wrap [])))
diff --git a/new-luxc/source/luxc/compiler/base.jvm.lux b/new-luxc/source/luxc/compiler/base.jvm.lux
new file mode 100644
index 000000000..f5784319a
--- /dev/null
+++ b/new-luxc/source/luxc/compiler/base.jvm.lux
@@ -0,0 +1,30 @@
+(;module:
+  lux
+  (lux (control monad)
+       [io #- run]
+       (concurrency ["A" atom])
+       (data ["E" error]
+             [text]
+             text/format)
+       host)
+  (luxc ["&" base]))
+
+(jvm-import java.lang.Class)
+(jvm-import java.lang.ClassLoader)
+(jvm-import org.objectweb.asm.MethodVisitor)
+
+(type: Blob Byte-Array)
+
+(type: JVM-State
+  {#visitor (Maybe MethodVisitor)
+   #loader ClassLoader
+   #store (A;Atom (D;Dict Text Blob))
+   })
+
+(def: host-state
+  JVM-State
+  (let [store (A;new (D;new text;Hash<Text>))]
+    {#visitor #;None
+     #loader (memory-class-loader store)
+     #store store
+     }))
diff --git a/new-luxc/source/luxc/compiler/expr.jvm.lux b/new-luxc/source/luxc/compiler/expr.jvm.lux
new file mode 100644
index 000000000..6655abd5f
--- /dev/null
+++ b/new-luxc/source/luxc/compiler/expr.jvm.lux
@@ -0,0 +1,27 @@
+(;module:
+  lux
+  (lux (control monad)
+       (data text/format)
+       [macro #+ Monad<Lux>])
+  (luxc ["&" base]
+        ["&;" module]
+        ["&;" env]
+        ["&;" analyser]
+        ["&;" synthesizer #+ Synthesis]))
+
+(type: #export JVM-Bytecode
+  Void)
+
+(type: Compiled
+  JVM-Bytecode)
+
+(def: (compile-synthesis synthesis)
+  (-> Synthesis Compiled)
+  (undefined))
+
+(def: #export (compile input)
+  (-> AST (Lux Compiled))
+  (|> input
+      &analyser;analyse
+      (Lux/map &synthesizer;synthesize)
+      (Lux/map compile-synthesis)))
diff --git a/new-luxc/source/luxc/compiler/runtime.jvm.lux b/new-luxc/source/luxc/compiler/runtime.jvm.lux
new file mode 100644
index 000000000..2d48b3617
--- /dev/null
+++ b/new-luxc/source/luxc/compiler/runtime.jvm.lux
@@ -0,0 +1,6 @@
+(;module:
+  lux
+  (lux (control monad)
+       (data text/format))
+  (luxc ["&" base]))
+
diff --git a/new-luxc/source/luxc/compiler/statement.jvm.lux b/new-luxc/source/luxc/compiler/statement.jvm.lux
new file mode 100644
index 000000000..c4c23746e
--- /dev/null
+++ b/new-luxc/source/luxc/compiler/statement.jvm.lux
@@ -0,0 +1,26 @@
+(;module:
+  lux
+  (lux (control monad)
+       [io #- run]
+       (data ["E" error]
+             [text "T/" Eq<Text>]
+             text/format)
+       [macro #+ Monad<Lux>])
+  (luxc ["&" base]
+        ["&;" module]
+        ["&;" env]
+        (compiler ["&;" expr])))
+
+(def: (compile-def def-name def-value def-meta)
+  (-> Text AST AST (Lux Unit))
+  (do Monad<Lux>
+    [=def-value (&expr;compile def-value)
+     =def-meta (&expr;compile def-meta)]
+    (undefined)))
+
+(def: (compile-program prog-args prog-body)
+  (-> Text AST (Lux Unit))
+  (do Monad<Lux>
+    [=prog-body (&env;with-local [prog-args (type (List Text))]
+                                 (&expr;compile prog-body))]
+    (undefined)))
diff --git a/new-luxc/source/luxc/env.lux b/new-luxc/source/luxc/env.lux
new file mode 100644
index 000000000..be68f84e9
--- /dev/null
+++ b/new-luxc/source/luxc/env.lux
@@ -0,0 +1,106 @@
+(;module:
+  lux
+  (lux (control monad)
+       (data [text "T/" Eq<Text>]
+             text/format
+             [maybe #+ Monad<Maybe> "Maybe/" Monad<Maybe>]
+             [product]
+             (coll [list "L/" Fold<List> Monoid<List>])))
+  (luxc ["&" base]))
+
+(type: Captured (Bindings Text [Type Ref]))
+
+(def: (pl::contains? key mappings)
+  (All [a] (-> Text (List [Text a]) Bool))
+  (case mappings
+    #;Nil
+    false
+
+    (#;Cons [k v] mappings')
+    (or (T/= key k)
+        (pl::contains? key mappings'))))
+
+(def: (pl::get key mappings)
+  (All [a] (-> Text (List [Text a]) (Maybe a)))
+  (case mappings
+    #;Nil
+    #;None
+
+    (#;Cons [k v] mappings')
+    (if (T/= key k)
+      (#;Some v)
+      (pl::get key mappings'))))
+
+(def: (pl::put key value mappings)
+  (All [a] (-> Text a (List [Text a]) (List [Text a])))
+  (case mappings
+    #;Nil
+    (list [key value])
+
+    (#;Cons [k v] mappings')
+    (if (T/= key k)
+      (#;Cons [key value] mappings')
+      (#;Cons [k v]
+              (pl::put key value mappings')))))
+
+(do-template [<slot> <is> <get> <then>]
+  [(def: (<is> name scope)
+     (-> Text Scope Bool)
+     (|> scope
+         (get@ [<slot> #;mappings])
+         (pl::contains? name)))
+
+   (def: (<get> name scope)
+     (-> Text Scope (Maybe [Type Ref]))
+     (|> scope
+         (get@ [<slot> #;mappings])
+         (pl::get name)
+         (Maybe/map (function [[type value]]
+                      [type (<then> value)]))))]
+
+  [#;locals   is-local?    get-local    #;Local]
+  [#;captured is-captured? get-captured id]
+  )
+
+(def: (is-ref? name scope)
+  (-> Text Scope Bool)
+  (or (is-local? name scope)
+      (is-captured? name scope)))
+
+(def: (get-ref name scope)
+  (-> Text Scope (Maybe [Type Ref]))
+  (case (get-local name scope)
+    (#;Some type)
+    (#;Some type)
+
+    _
+    (get-captured name scope)))
+
+(def: #export (find name)
+  (-> Text (Lux (Maybe [Type Ref])))
+  (function [compiler]
+    (let [[inner outer] (|> compiler
+                            (get@ #;scopes)
+                            (list;split-with (|>. (is-ref? name) not)))]
+      (case outer
+        #;Nil
+        (#;Right [compiler #;None])
+
+        (#;Cons top-outer _)
+        (let [[ref-type init-ref] (default (undefined)
+                                    (get-ref name top-outer))
+              [ref inner'] (L/fold (: (-> Scope [Ref (List Scope)] [Ref (List Scope)])
+                                      (function [scope [ref inner]]
+                                        [(#;Captured (get@ [#;captured #;counter] scope))
+                                         (#;Cons (update@ #;captured
+                                                          (: (-> Captured Captured)
+                                                             (|>. (update@ #;counter n.inc)
+                                                                  (update@ #;mappings (pl::put name [ref-type ref]))))
+                                                          scope)
+                                                 inner)]))
+                                   [init-ref #;Nil]
+                                   (list;reverse inner))
+              scopes (L/append inner' outer)]
+          (#;Right [(set@ #;scopes scopes compiler)
+                    (#;Some [ref-type ref])]))
+        ))))
diff --git a/new-luxc/source/luxc/io.jvm.lux b/new-luxc/source/luxc/io.jvm.lux
new file mode 100644
index 000000000..ab62b8f43
--- /dev/null
+++ b/new-luxc/source/luxc/io.jvm.lux
@@ -0,0 +1,93 @@
+(;module:
+  lux
+  (lux (control monad)
+       [io #- run]
+       (concurrency ["P" promise])
+       (data ["E" error]
+             [text "T/" Eq<Text>]
+             text/format)
+       [macro]
+       host)
+  (luxc ["&" base]))
+
+(jvm-import java.io.File
+  (new [String String])
+  (exists [] #io #try boolean))
+
+(jvm-import java.io.Reader
+  (close [] #io #try void))
+
+(jvm-import java.io.FileReader
+  (new [File]))
+
+(jvm-import java.io.BufferedReader
+  (new [Reader])
+  (readLine [] #io #try #? String))
+
+(def: host-extension Text ".jvm")
+
+(def: (find-in-sources path source-dirs)
+  (-> &;Path (List &;Path) (P;Promise (Maybe File)))
+  (loop [source-dirs source-dirs]
+    (case source-dirs
+      #;Nil
+      (:: P;Monad<Promise> wrap #;None)
+
+      (#;Cons dir source-dirs')
+      (do P;Monad<Promise>
+        [#let [file (File.new [dir path])]
+         ?? (P;future (File.exists [] file))]
+        (case ??
+          (#;Right true)
+          (wrap (#;Some file))
+
+          _
+          (recur source-dirs'))))))
+
+(def: (read-source-code lux-file)
+  (-> File (P;Promise (E;Error Text)))
+  (P;future
+   (let [reader (|> lux-file FileReader.new BufferedReader.new)]
+     (loop [total ""]
+       (do Monad<IO>
+         [?line (BufferedReader.readLine [] reader)]
+         (case ?line
+           (#E;Error error)
+           (wrap (#E;Error error))
+
+           (#E;Success #;None)
+           (wrap (#E;Success total))
+
+           (#E;Success (#;Some line))
+           (if (T/= "" total)
+             (recur line)
+             (recur (format total "\n" line)))))))))
+
+(def: #export (read-module source-dirs module-name)
+  (-> (List &;Path) Text (P;Promise (E;Error [&;Path Text])))
+  (let [host-path (format module-name host-extension ".lux")
+        lux-path (format module-name ".lux")]
+    (let% [<tries> (do-template [<path>]
+                     [(do P;Monad<Promise>
+                        [?file (find-in-sources <path> source-dirs)])
+                      (case ?file
+                        (#;Some file)
+                        (do @
+                          [?code (read-source-code file)]
+                          (case ?code
+                            (#E;Error error)
+                            (wrap (#E;Error error))
+
+                            (#E;Success code)
+                            (wrap (#E;Success [<path> code]))))
+
+                        #;None)]
+
+                     [host-path]
+                     [lux-path])]
+      (<| <tries>
+          (wrap (#E;Error (format "Module cannot be found: " module-name)))))))
+
+(def: #export (write-module module-name module-descriptor)
+  (-> Text Text (P;Promise Unit))
+  (undefined))
diff --git a/new-luxc/source/luxc/module.lux b/new-luxc/source/luxc/module.lux
new file mode 100644
index 000000000..2d48b3617
--- /dev/null
+++ b/new-luxc/source/luxc/module.lux
@@ -0,0 +1,6 @@
+(;module:
+  lux
+  (lux (control monad)
+       (data text/format))
+  (luxc ["&" base]))
+
diff --git a/new-luxc/source/luxc/module/def.lux b/new-luxc/source/luxc/module/def.lux
new file mode 100644
index 000000000..2d48b3617
--- /dev/null
+++ b/new-luxc/source/luxc/module/def.lux
@@ -0,0 +1,6 @@
+(;module:
+  lux
+  (lux (control monad)
+       (data text/format))
+  (luxc ["&" base]))
+
diff --git a/new-luxc/source/luxc/module/descriptor/annotation.lux b/new-luxc/source/luxc/module/descriptor/annotation.lux
new file mode 100644
index 000000000..9a687e02a
--- /dev/null
+++ b/new-luxc/source/luxc/module/descriptor/annotation.lux
@@ -0,0 +1,83 @@
+(;module:
+  lux
+  (lux (control codec
+                monad)
+       (data [text]
+             (text format
+                   ["l" lexer "l/" Monad<Lexer>])
+             [char]
+             [number]
+             error
+             (coll [list "L/" Functor<List>])))
+  ["&" ../common]
+  [luxc ["&;" parser]])
+
+(def: dummy-cursor Cursor ["" +0 +0])
+
+(do-template [<name> <code>]
+  [(def: <name> &;Signal <code>)]
+
+  [ident-signal "@"]
+  [bool-signal  "B"]
+  [nat-signal   "N"]
+  [int-signal   "I"]
+  [deg-signal   "D"]
+  [real-signal  "R"]
+  [char-signal  "C"]
+  [text-signal  "T"]
+  [list-signal  "%"]
+  [dict-signal  "#"]
+  )
+
+(def: (encode-ident [module name])
+  (-> Ident Text)
+  (format ident-signal
+          module &;ident-separator name
+          &;stop-signal))
+
+(def: (encode-text value)
+  (-> Text Text)
+  (format text-signal
+          (%t value)
+          &;stop-signal))
+
+(def: (encode-ann-value value)
+  (-> Ann-Value Text)
+  (case value
+    (^template [<tag> <signal> <encoder>]
+      (<tag> value)
+      (format <signal>
+              (<encoder> value)
+              &;stop-signal))
+    ([#;BoolA  bool-signal  %b]
+     [#;NatA   nat-signal   %n]
+     [#;IntA   int-signal   %i]
+     [#;DegA   deg-signal   %d]
+     [#;RealA  real-signal  %r]
+     [#;CharA  char-signal  %c]
+     [#;TextA  text-signal  %t]
+     [#;IdentA ident-signal %ident]
+     [#;ListA  list-signal  (&;encode-list encode-ann-value)]
+     [#;DictA  dict-signal  (&;encode-list (function [[k v]]
+                                             (format (encode-text k)
+                                                     (encode-ann-value v))))])))
+
+(def: ann-value-decoder
+  (l;Lexer Ann-Value)
+  (let% [<simple> (do-template [<tag> <lexer> <signal>]
+                    [(do l;Monad<Lexer>
+                       [])])]
+    ($_ l;either
+        <simple>
+        (|> ... (l;after (l;text bool-signal)))
+        )))
+
+(def: encode-anns
+  (-> Anns Text)
+  (&;encode-list (function [[ident value]]
+                   (format (encode-ident ident)
+                           (encode-ann-value value)))))
+
+(struct: #export _ (Codec Text Anns)
+  (def: encode encode-anns)
+  (def: decode decode-anns))
diff --git a/new-luxc/source/luxc/module/descriptor/common.lux b/new-luxc/source/luxc/module/descriptor/common.lux
new file mode 100644
index 000000000..60a313115
--- /dev/null
+++ b/new-luxc/source/luxc/module/descriptor/common.lux
@@ -0,0 +1,38 @@
+(;module:
+  lux
+  (lux (data [text]
+             (text format
+                   ["l" lexer "l/" Monad<Lexer>])
+             [char]
+             (coll [list "L/" Functor<List>]))))
+
+(type: #export Signal Text)
+
+(do-template [<name> <code>]
+  [(def: #export <name> Signal (|> <code> char;char char;as-text))]
+
+  [cons-signal +5]
+  [nil-signal  +6]
+  [stop-signal +7]
+  )
+
+(do-template [<name> <code>]
+  [(def: #export <name> Signal <code>)]
+
+  [ident-separator ";"]
+  )
+
+(def: #export (encode-list encode-elem types)
+  (All [a] (-> (-> a Text) (List a) Text))
+  (format (|> (L/map encode-elem types)
+              (text;join-with cons-signal))
+          nil-signal))
+
+(def: #export (decode-list decode-elem)
+  (All [a] (-> (l;Lexer a) (l;Lexer (List a))))
+  (l;alt (<| (l;after (l;text nil-signal))
+             (l/wrap []))
+         (<| (l;seq decode-elem)
+             (l;after (l;text cons-signal))
+             (decode-list decode-elem))))
+
diff --git a/new-luxc/source/luxc/module/descriptor/type.lux b/new-luxc/source/luxc/module/descriptor/type.lux
new file mode 100644
index 000000000..c4078ec0e
--- /dev/null
+++ b/new-luxc/source/luxc/module/descriptor/type.lux
@@ -0,0 +1,145 @@
+(;module:
+  lux
+  (lux (control codec
+                monad)
+       (data [text]
+             (text format
+                   ["l" lexer "l/" Monad<Lexer>])
+             [char]
+             [number]
+             error
+             (coll [list "L/" Functor<List>]))
+       [type "Type/" Eq<Type>])
+  ["&" ../common])
+
+(do-template [<name> <code>]
+  [(def: <name> &;Signal <code>)]
+
+  [type-signal        "T"]
+  [host-signal        "^"]
+  [void-signal        "0"]
+  [unit-signal        "1"]
+  [product-signal     "*"]
+  [sum-signal         "+"]
+  [function-signal    ">"]
+  [application-signal "%"]
+  [uq-signal          "U"]
+  [eq-signal          "E"]
+  [bound-signal       "$"]
+  [ex-signal          "!"]
+  [var-signal         "?"]
+  [named-signal       "@"]
+  )
+
+(def: (encode-type type)
+  (-> Type Text)
+  (if (or (is Type type)
+          (Type/= Type type))
+    type-signal
+    (case type
+      (#;HostT name params)
+      (format host-signal name &;stop-signal (&;encode-list encode-type params))
+
+      #;VoidT
+      void-signal
+
+      #;UnitT
+      unit-signal
+
+      (^template [<tag> <prefix>]
+        (<tag> left right)
+        (format <prefix> (encode-type left) (encode-type right)))
+      ([#;ProdT     product-signal]
+       [#;SumT      sum-signal]
+       [#;FunctionT function-signal]
+       [#;AppT      application-signal])
+
+
+      (^template [<tag> <prefix>]
+        (<tag> env body)
+        (format <prefix> (&;encode-list encode-type env) (encode-type body)))
+      ([#;UnivQ uq-signal]
+       [#;ExQ   eq-signal])
+
+      (^template [<tag> <prefix>]
+        (<tag> idx)
+        (format <prefix> (%i (nat-to-int idx)) &;stop-signal))
+      ([#;BoundT bound-signal]
+       [#;ExT ex-signal]
+       [#;VarT var-signal])
+
+      (#;NamedT [module name] type*)
+      (format named-signal module &;ident-separator name &;stop-signal (encode-type type*))
+      )))
+
+(def: type-decoder
+  (l;Lexer Type)
+  (l;rec
+   (function [type-decoder]
+     (let% [<simple> (do-template [<type> <signal>]
+                       [(|> (l/wrap <type>) (l;after (l;text <signal>)))]
+
+                       [Type    type-signal]
+                       [#;VoidT void-signal]
+                       [#;UnitT unit-signal])
+            <combinators> (do-template [<tag> <prefix>]
+                            [(do l;Monad<Lexer>
+                               [_ (l;text <prefix>)
+                                left type-decoder
+                                right type-decoder]
+                               (wrap (<tag> left right)))]
+
+                            [#;ProdT     product-signal]
+                            [#;SumT      sum-signal]
+                            [#;FunctionT function-signal]
+                            [#;AppT      application-signal])
+            <abstractions> (do-template [<tag> <prefix>]
+                             [(do l;Monad<Lexer>
+                                [_ (l;text <prefix>)
+                                 env (&;decode-list type-decoder)
+                                 body type-decoder]
+                                (wrap (<tag> env body)))]
+
+                             [#;UnivQ uq-signal]
+                             [#;ExQ   eq-signal])
+            <wildcards> (do-template [<tag> <prefix>]
+                          [(do l;Monad<Lexer>
+                             [_ (l;text <prefix>)
+                              id (l;codec number;Codec<Text,Int>
+                                          (l;some' l;digit))
+                              _ (l;text &;stop-signal)]
+                             (wrap (<tag> (int-to-nat id))))]
+
+                          [#;BoundT bound-signal]
+                          [#;ExT    ex-signal]
+                          [#;VarT   var-signal])]
+       ($_ l;either
+           (do l;Monad<Lexer>
+             [_ (l;text host-signal)
+              name (l;many' (l;none-of &;stop-signal))
+              _ (l;text &;stop-signal)
+              params (&;decode-list type-decoder)]
+             (wrap (#;HostT name params)))
+           <simple>
+           <combinators>
+           <abstractions>
+           <wildcards>
+           (do l;Monad<Lexer>
+             [_ (l;text named-signal)
+              module (l;some' (l;none-of &;ident-separator))
+              _ (l;text &;ident-separator)
+              name (l;many' (l;none-of &;stop-signal))
+              _ (l;text &;stop-signal)
+              unnamed type-decoder]
+             (wrap (#;NamedT [module name] unnamed)))
+           )))))
+
+(def: (decode-type input)
+  (-> Text (Error Type))
+  (|> type-decoder
+      (l;before l;end)
+      (l;run input)))
+
+(struct: #export _ (Codec Text Type)
+  (def: encode encode-type)
+  (def: decode decode-type))
diff --git a/new-luxc/source/luxc/parser.lux b/new-luxc/source/luxc/parser.lux
index cac3cb862..4ca97a80a 100644
--- a/new-luxc/source/luxc/parser.lux
+++ b/new-luxc/source/luxc/parser.lux
@@ -210,7 +210,7 @@
 ## specific shapes and then use decoders already present in the
 ## standard library to actually produce the values from the literals.
 (do-template [<name> <tag> <lexer> <codec>]
-  [(def: (<name> where)
+  [(def: #export (<name> where)
      (-> Cursor (Lexer [AST Cursor]))
      (do Monad<Lexer>
        [chunk <lexer>]
@@ -223,20 +223,20 @@
                 (|> where
                     (update@ #;column (n.+ (text;size chunk))))]))))]
 
-  [bool^ #;BoolS
+  [parse-bool #;BoolS
    (l;either (l;text "true") (l;text "false"))
    bool;Codec<Text,Bool>]
   
-  [nat^ #;NatS
+  [parse-nat #;NatS
    (l;seq' (l;text "+") (l;many' l;digit))
    number;Codec<Text,Nat>]
   
-  [int^ #;IntS
+  [parse-int #;IntS
    (l;seq' (l;default "" (l;text "-"))
            (l;many' l;digit))
    number;Codec<Text,Int>]
   
-  [real^ #;RealS
+  [parse-real #;RealS
    ($_ l;seq'
        (l;default "" (l;text "-"))
        (l;many' l;digit)
@@ -244,7 +244,7 @@
        (l;many' l;digit))
    number;Codec<Text,Real>]
   
-  [deg^ #;DegS
+  [parse-deg #;DegS
    (l;seq' (l;text ".")
            (l;many' l;digit))
    number;Codec<Text,Deg>]
@@ -252,7 +252,7 @@
 
 ## This parser doesn't delegate the work of producing the value to a
 ## codec, since the raw-char^ parser already takes care of that magic.
-(def: (char^ where)
+(def: #export (parse-char where)
   (-> Cursor (Lexer [AST Cursor]))
   (do Monad<Lexer>
     [[chunk value] (l;enclosed ["#\"" "\""]
@@ -263,7 +263,7 @@
 
 ## This parser looks so complex because text in Lux can be multi-line
 ## and there are rules regarding how this is handled.
-(def: (text^ where)
+(def: #export (parse-text where)
   (-> Cursor (Lexer [AST Cursor]))
   (do Monad<Lexer>
     [## Lux text "is delimited by double-quotes", as usual in most
@@ -354,7 +354,7 @@
 ## delimiters involved.
 ## They may have an arbitrary number of arbitrary AST nodes as elements.
 (do-template [<name> <tag> <open> <close>]
-  [(def: (<name> where ast^)
+  [(def: (<name> where parse-ast)
      (-> Cursor
          (-> Cursor (Lexer [AST Cursor]))
          (Lexer [AST Cursor]))
@@ -366,7 +366,7 @@
                          (l;either (do @
                                      [## Must update the cursor as I
                                       ## go along, to keep things accurate.
-                                      [elem where'] (ast^ where)]
+                                      [elem where'] (parse-ast where)]
                                      (recur (V;add elem elems)
                                             where'))
                                    (do @
@@ -381,8 +381,8 @@
        (wrap [[where (<tag> elems)]
               where'])))]
 
-  [form^   #;FormS   "(" ")"]
-  [tuple^  #;TupleS  "[" "]"]
+  [parse-form   #;FormS   "(" ")"]
+  [parse-tuple  #;TupleS  "[" "]"]
   )
 
 ## Records are almost (syntactically) the same as forms and tuples,
@@ -394,7 +394,7 @@
 ## AST node, however, record AST nodes allow any AST node to occupy
 ## this position, since it may be useful when processing AST syntax in
 ## macros.
-(def: (record^ where ast^)
+(def: (parse-record where parse-ast)
   (-> Cursor
       (-> Cursor (Lexer [AST Cursor]))
       (Lexer [AST Cursor]))
@@ -404,8 +404,8 @@
                                     V;empty)
                            where where]
                       (l;either (do @
-                                  [[key where'] (ast^ where)
-                                   [val where'] (ast^ where')]
+                                  [[key where'] (parse-ast where)
+                                   [val where'] (parse-ast where')]
                                   (recur (V;add [key val] elems)
                                          where'))
                                 (do @
@@ -505,7 +505,7 @@
 ## provide the compiler with information related to data-structure
 ## construction and de-structuring (during pattern-matching).
 (do-template [<name> <tag> <lexer> <extra>]
-  [(def: (<name> where)
+  [(def: #export (<name> where)
      (-> Cursor (Lexer [AST Cursor]))
      (do Monad<Lexer>
        [[value length] <lexer>]
@@ -513,29 +513,29 @@
               (|> where
                   (update@ #;column (|>. ($_ n.+ <extra> length))))])))]
 
-  [symbol^ #;SymbolS ident^                         +0]
-  [tag^    #;TagS    (l;after (l;char #"#") ident^) +1]
+  [parse-symbol #;SymbolS ident^                         +0]
+  [parse-tag    #;TagS    (l;after (l;char #"#") ident^) +1]
   )
 
-(def: (ast^ where)
+(def: (parse-ast where)
   (-> Cursor (Lexer [AST Cursor]))
   (do Monad<Lexer>
     [where (left-padding^ where)]
     ($_ l;either
-        (form^ where ast^)
-        (tuple^ where ast^)
-        (record^ where ast^)
-        (bool^ where)
-        (nat^ where)
-        (real^ where)
-        (int^ where)
-        (deg^ where)
-        (symbol^ where)
-        (tag^ where)
-        (char^ where)
-        (text^ where)
+        (parse-form where parse-ast)
+        (parse-tuple where parse-ast)
+        (parse-record where parse-ast)
+        (parse-bool where)
+        (parse-nat where)
+        (parse-real where)
+        (parse-int where)
+        (parse-deg where)
+        (parse-symbol where)
+        (parse-tag where)
+        (parse-char where)
+        (parse-text where)
         )))
 
 (def: #export (parse where code)
   (-> Cursor Text (Error [Text AST Cursor]))
-  (l;run' code (ast^ where)))
+  (l;run' code (parse-ast where)))
diff --git a/new-luxc/source/luxc/synthesizer.lux b/new-luxc/source/luxc/synthesizer.lux
new file mode 100644
index 000000000..682bbe3ec
--- /dev/null
+++ b/new-luxc/source/luxc/synthesizer.lux
@@ -0,0 +1,14 @@
+(;module:
+  lux
+  (lux (control monad)
+       (data text/format)
+       [macro #+ Monad<Lux>])
+  (luxc ["&" base]
+        ["&;" analyser #+ Analysis]))
+
+(type: #export Synthesis
+  Unit)
+
+(def: #export (synthesize analysis)
+  (-> Analysis Synthesis)
+  (undefined))
diff --git a/new-luxc/source/program.lux b/new-luxc/source/program.lux
index b1619e830..07f21962b 100644
--- a/new-luxc/source/program.lux
+++ b/new-luxc/source/program.lux
@@ -3,27 +3,16 @@
   (lux (control monad)
        [io #- run]
        [cli #+ program: CLI Monad<CLI>])
-  (luxc ["&;" parser]))
-
-(type: Path Text)
-
-(type: Platform
-  #JVM
-  #JS)
-
-(type: Mode
-  #Release
-  #Debug)
+  (luxc ["&" base]
+        ["&;" parser]
+        ["&;" compiler]
+        (module (descriptor ["&;" type]))
+        ))
 
 (type: Compilation
-  {#mode Mode
-   #platform Platform
-   #program Path
-   #target Path})
-
-(type: Inputs
-  {#resources (List Path)
-   #sources (List Path)})
+  {#mode &;Mode
+   #program &;Path
+   #target &;Path})
 
 (def: (marker tokens)
   (-> (List Text) (CLI Unit))
@@ -36,37 +25,23 @@
              cli;any))
 
 (def: mode^
-  (CLI Mode)
+  (CLI &;Mode)
   ($_ cli;alt
       (marker (list "release"))
       (marker (list "debug"))))
 
-(def: platform^
-  (CLI Platform)
-  ($_ cli;alt
-      (marker (list "jvm"))
-      (marker (list "js"))))
-
 (def: compilation^
   (CLI Compilation)
   ($_ cli;seq
       mode^
-      platform^
       (tagged (list "-p" "--program"))
       (tagged (list "-t" "--target"))))
 
-(def: inputs^
-  (CLI Inputs)
-  ($_ cli;seq
-      (cli;some (tagged (list "-r" "--resource")))
-      (cli;some (tagged (list "-s" "--source")))))
-
-(program: ([[command [resources sources]]
-            (cli;seq (cli;opt compilation^)
-                     inputs^)])
+(program: ([command (cli;opt compilation^)]
+           [sources (cli;some (tagged (list "-s" "--source")))])
   (case command
     #;None
     (io (log! "Hello, REPL!"))
 
-    (#;Some [mode platform program target])
-    (io (log! "Hello, compilation!"))))
+    (#;Some [mode program target])
+    (&compiler;compile-program mode program target sources)))