- All analysis procedures have been turned into extensions.

10 files changed, 88 insertions, 95 deletions

diff --git a/new-luxc/source/luxc/lang/analysis/expression.lux b/new-luxc/source/luxc/lang/analysis/expression.lux
index 1463e7ec5..d19e98bd8 100644
--- a/new-luxc/source/luxc/lang/analysis/expression.lux
+++ b/new-luxc/source/luxc/lang/analysis/expression.lux
@@ -13,14 +13,14 @@
         (lang ["&." module]
               [".L" host]
               [".L" macro]
+              [".L" extension]
               ["la" analysis]
               (translation [".T" common])))
   (// [".A" common]
       [".A" function]
       [".A" primitive]
       [".A" reference]
-      [".A" structure]
-      [".A" procedure]))
+      [".A" structure]))
 
 (exception: #export Macro-Expression-Must-Have-Single-Expansion)
 (exception: #export Unrecognized-Syntax)
@@ -64,7 +64,9 @@
                (referenceA.analyse-reference reference)
 
                (^ (#.Form (list& [_ (#.Text proc-name)] proc-args)))
-               (procedureA.analyse-procedure analyse eval proc-name proc-args)
+               (do macro.Monad<Meta>
+                 [procedure (extensionL.find-analysis proc-name)]
+                 (procedure analyse eval proc-args))
 
                (^template [<tag> <analyser>]
                  (^ (#.Form (list& [_ (<tag> tag)]
diff --git a/new-luxc/source/luxc/lang/analysis/procedure.lux b/new-luxc/source/luxc/lang/analysis/procedure.lux
deleted file mode 100644
index 25e1be335..000000000
--- a/new-luxc/source/luxc/lang/analysis/procedure.lux
+++ /dev/null
@@ -1,26 +0,0 @@
-(.module:
-  lux
-  (lux (control [monad #+ do]
-                ["ex" exception #+ exception:])
-       (data [maybe]
-             [text]
-             text/format
-             (coll [dict])))
-  (luxc ["&" lang]
-        (lang ["la" analysis]))
-  (/ ["/." common]
-     ["/." host]))
-
-(exception: #export Unknown-Procedure)
-
-(def: procedures
-  /common.Bundle
-  (|> /common.procedures
-      (dict.merge /host.procedures)))
-
-(def: #export (analyse-procedure analyse eval proc-name proc-args)
-  (-> &.Analyser &.Eval Text (List Code) (Meta la.Analysis))
-  (<| (maybe.default (&.throw Unknown-Procedure (%t proc-name)))
-      (do maybe.Monad<Maybe>
-        [proc (dict.get proc-name procedures)]
-        (wrap ((proc proc-name) analyse eval proc-args)))))
diff --git a/new-luxc/source/luxc/lang/extension.lux b/new-luxc/source/luxc/lang/extension.lux
index d38d564fb..248bfbb71 100644
--- a/new-luxc/source/luxc/lang/extension.lux
+++ b/new-luxc/source/luxc/lang/extension.lux
@@ -18,16 +18,24 @@
 (exception: #export Cannot-Define-Translation-More-Than-Once)
 (exception: #export Cannot-Define-Statement-More-Than-Once)
 
-(type: #export Expression
+(type: #export Analysis
+  (-> (-> Code (Meta Code))
+      (-> Type Code (Meta Top))
+      (List Code) (Meta Code)))
+
+(type: #export Synthesis
+  (-> (List Code) (Meta Code)))
+
+(type: #export Translation
   (-> (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)
+  {#analysis (Dict Text Analysis)
+   #synthesis (Dict Text Synthesis)
+   #translation (Dict Text Translation)
    #statement (Dict Text Statement)})
 
 (def: #export fresh
@@ -61,10 +69,10 @@
          #.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]
+  [find-analysis    Analysis    #analysis    Unknown-Analysis]
+  [find-synthesis   Synthesis   #synthesis   Unknown-Synthesis]
+  [find-translation Translation #translation Unknown-Translation]
+  [find-statement   Statement   #statement   Unknown-Statement]
   )
 
 (do-template [<name> <type> <category> <exception>]
@@ -77,8 +85,8 @@
         _ (..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]
+  [install-analysis    Analysis    #analysis    Cannot-Define-Analysis-More-Than-Once]
+  [install-synthesis   Synthesis   #synthesis   Cannot-Define-Synthesis-More-Than-Once]
+  [install-translation Translation #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
index d034f2919..30f43acef 100644
--- a/new-luxc/source/luxc/lang/extension/analysis.lux
+++ b/new-luxc/source/luxc/lang/extension/analysis.lux
@@ -1,9 +1,19 @@
 (.module:
   lux
   (lux (data [text]
-             (coll [dict #+ Dict])))
-  [//])
+             (coll [list "list/" Functor<List>]
+                   [dict #+ Dict])))
+  [//]
+  [/common]
+  [/host])
+
+(def: realize
+  (-> /common.Bundle (Dict Text //.Analysis))
+  (|>> dict.entries
+       (list/map (function [[name proc]] [name (proc name)]))
+       (dict.from-list text.Hash<Text>)))
 
 (def: #export defaults
-  (Dict Text //.Expression)
-  (dict.new text.Hash<Text>))
+  (Dict Text //.Analysis)
+  (realize (dict.merge /common.procedures
+                       /host.procedures)))
diff --git a/new-luxc/source/luxc/lang/analysis/procedure/common.lux b/new-luxc/source/luxc/lang/extension/analysis/common.lux
index ecdcd0bfd..079001b26 100644
--- a/new-luxc/source/luxc/lang/analysis/procedure/common.lux
+++ b/new-luxc/source/luxc/lang/extension/analysis/common.lux
@@ -17,20 +17,18 @@
               (analysis ["&." common]
                         [".A" function]
                         [".A" case]
-                        [".A" type]))))
+                        [".A" type])))
+  [///])
 
 (exception: #export Incorrect-Procedure-Arity)
 (exception: #export Invalid-Syntax)
 
 ## [Utils]
-(type: #export Proc
-  (-> &.Analyser &.Eval (List Code) (Meta la.Analysis)))
-
 (type: #export Bundle
-  (Dict Text (-> Text Proc)))
+  (Dict Text (-> Text ///.Analysis)))
 
 (def: #export (install name unnamed)
-  (-> Text (-> Text Proc)
+  (-> Text (-> Text ///.Analysis)
       (-> Bundle Bundle))
   (dict.put name unnamed))
 
@@ -48,7 +46,7 @@
           "   Actual Arity: " (|> actual nat-to-int %i)))
 
 (def: (simple proc inputsT+ outputT)
-  (-> Text (List Type) Type Proc)
+  (-> Text (List Type) Type ///.Analysis)
   (let [num-expected (list.size inputsT+)]
     (function [analyse eval args]
       (let [num-actual (list.size args)]
@@ -64,25 +62,25 @@
           (&.throw Incorrect-Procedure-Arity (wrong-arity proc num-expected num-actual)))))))
 
 (def: #export (nullary valueT proc)
-  (-> Type Text Proc)
+  (-> Type Text ///.Analysis)
   (simple proc (list) valueT))
 
 (def: #export (unary inputT outputT proc)
-  (-> Type Type Text Proc)
+  (-> Type Type Text ///.Analysis)
   (simple proc (list inputT) outputT))
 
 (def: #export (binary subjectT paramT outputT proc)
-  (-> Type Type Type Text Proc)
+  (-> Type Type Type Text ///.Analysis)
   (simple proc (list subjectT paramT) outputT))
 
 (def: #export (trinary subjectT param0T param1T outputT proc)
-  (-> Type Type Type Type Text Proc)
+  (-> Type Type Type Type Text ///.Analysis)
   (simple proc (list subjectT param0T param1T) outputT))
 
 ## [Analysers]
 ## "lux is" represents reference/pointer equality.
 (def: (lux//is proc)
-  (-> Text Proc)
+  (-> Text ///.Analysis)
   (function [analyse eval args]
     (do macro.Monad<Meta>
       [[var-id varT] (&.with-type-env tc.var)]
@@ -92,7 +90,7 @@
 ## "lux try" provides a simple way to interact with the host platform's
 ## error-handling facilities.
 (def: (lux//try proc)
-  (-> Text Proc)
+  (-> Text ///.Analysis)
   (function [analyse eval args]
     (case args
       (^ (list opC))
@@ -107,7 +105,7 @@
       (&.throw Incorrect-Procedure-Arity (wrong-arity proc +1 (list.size args))))))
 
 (def: (lux//function proc)
-  (-> Text Proc)
+  (-> Text ///.Analysis)
   (function [analyse eval args]
     (case args
       (^ (list [_ (#.Symbol ["" func-name])]
@@ -119,7 +117,7 @@
       (&.throw Incorrect-Procedure-Arity (wrong-arity proc +3 (list.size args))))))
 
 (def: (lux//case proc)
-  (-> Text Proc)
+  (-> Text ///.Analysis)
   (function [analyse eval args]
     (case args
       (^ (list input [_ (#.Record branches)]))
@@ -129,7 +127,7 @@
       (&.throw Incorrect-Procedure-Arity (wrong-arity proc +2 (list.size args))))))
 
 (def: (lux//in-module proc)
-  (-> Text Proc)
+  (-> Text ///.Analysis)
   (function [analyse eval argsC+]
     (case argsC+
       (^ (list [_ (#.Text module-name)] exprC))
@@ -146,7 +144,7 @@
 
 (do-template [<name> <analyser>]
   [(def: (<name> proc)
-     (-> Text Proc)
+     (-> Text ///.Analysis)
      (function [analyse eval args]
        (case args
          (^ (list typeC valueC))
@@ -159,7 +157,7 @@
   [lux//coerce typeA.analyse-coerce])
 
 (def: (lux//check//type proc)
-  (-> Text Proc)
+  (-> Text ///.Analysis)
   (function [analyse eval args]
     (case args
       (^ (list valueC))
@@ -296,7 +294,7 @@
           )))
 
 (def: (array//get proc)
-  (-> Text Proc)
+  (-> Text ///.Analysis)
   (function [analyse eval args]
     (do macro.Monad<Meta>
       [[var-id varT] (&.with-type-env tc.var)]
@@ -304,7 +302,7 @@
        analyse eval args))))
 
 (def: (array//put proc)
-  (-> Text Proc)
+  (-> Text ///.Analysis)
   (function [analyse eval args]
     (do macro.Monad<Meta>
       [[var-id varT] (&.with-type-env tc.var)]
@@ -312,7 +310,7 @@
        analyse eval args))))
 
 (def: (array//remove proc)
-  (-> Text Proc)
+  (-> Text ///.Analysis)
   (function [analyse eval args]
     (do macro.Monad<Meta>
       [[var-id varT] (&.with-type-env tc.var)]
@@ -355,7 +353,7 @@
           )))
 
 (def: (atom-new proc)
-  (-> Text Proc)
+  (-> Text ///.Analysis)
   (function [analyse eval args]
     (case args
       (^ (list initC))
@@ -370,7 +368,7 @@
       (&.throw Incorrect-Procedure-Arity (wrong-arity proc +1 (list.size args))))))
 
 (def: (atom-read proc)
-  (-> Text Proc)
+  (-> Text ///.Analysis)
   (function [analyse eval args]
     (do macro.Monad<Meta>
       [[var-id varT] (&.with-type-env tc.var)]
@@ -378,7 +376,7 @@
        analyse eval args))))
 
 (def: (atom//compare-and-swap proc)
-  (-> Text Proc)
+  (-> Text ///.Analysis)
   (function [analyse eval args]
     (do macro.Monad<Meta>
       [[var-id varT] (&.with-type-env tc.var)]
diff --git a/new-luxc/source/luxc/lang/analysis/procedure/host.jvm.lux b/new-luxc/source/luxc/lang/extension/analysis/host.jvm.lux
index 3c29410d0..dba0e3e66 100644
--- a/new-luxc/source/luxc/lang/analysis/procedure/host.jvm.lux
+++ b/new-luxc/source/luxc/lang/extension/analysis/host.jvm.lux
@@ -26,6 +26,7 @@
               (analysis ["&." common]
                         [".A" inference])))
   ["@" //common]
+  [///]
   )
 
 (exception: #export Wrong-Syntax)
@@ -190,7 +191,7 @@
       (dict.from-list text.Hash<Text>)))
 
 (def: (array-length proc)
-  (-> Text @.Proc)
+  (-> Text ///.Analysis)
   (function [analyse eval args]
     (case args
       (^ (list arrayC))
@@ -205,7 +206,7 @@
       (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +1 (list.size args))))))
 
 (def: (array-new proc)
-  (-> Text @.Proc)
+  (-> Text ///.Analysis)
   (function [analyse eval args]
     (case args
       (^ (list lengthC))
@@ -296,7 +297,7 @@
     (&.throw Invalid-Type-For-Array-Element (%type elemT))))
 
 (def: (array-read proc)
-  (-> Text @.Proc)
+  (-> Text ///.Analysis)
   (function [analyse eval args]
     (case args
       (^ (list arrayC idxC))
@@ -316,7 +317,7 @@
       (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +2 (list.size args))))))
 
 (def: (array-write proc)
-  (-> Text @.Proc)
+  (-> Text ///.Analysis)
   (function [analyse eval args]
     (case args
       (^ (list arrayC idxC valueC))
@@ -348,7 +349,7 @@
           )))
 
 (def: (object-null proc)
-  (-> Text @.Proc)
+  (-> Text ///.Analysis)
   (function [analyse eval args]
     (case args
       (^ (list))
@@ -361,7 +362,7 @@
       (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +0 (list.size args))))))
 
 (def: (object-null? proc)
-  (-> Text @.Proc)
+  (-> Text ///.Analysis)
   (function [analyse eval args]
     (case args
       (^ (list objectC))
@@ -376,7 +377,7 @@
       (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +1 (list.size args))))))
 
 (def: (object-synchronized proc)
-  (-> Text @.Proc)
+  (-> Text ///.Analysis)
   (function [analyse eval args]
     (case args
       (^ (list monitorC exprC))
@@ -471,7 +472,7 @@
     (wrap (Class::isAssignableFrom [sub] super))))
 
 (def: (object-throw proc)
-  (-> Text @.Proc)
+  (-> Text ///.Analysis)
   (function [analyse eval args]
     (case args
       (^ (list exceptionC))
@@ -491,7 +492,7 @@
       (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +1 (list.size args))))))
 
 (def: (object-class proc)
-  (-> Text @.Proc)
+  (-> Text ///.Analysis)
   (function [analyse eval args]
     (case args
       (^ (list classC))
@@ -509,7 +510,7 @@
       (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +1 (list.size args))))))
 
 (def: (object-instance? proc)
-  (-> Text @.Proc)
+  (-> Text ///.Analysis)
   (function [analyse eval args]
     (case args
       (^ (list classC objectC))
@@ -804,7 +805,7 @@
     (wrap [castT unboxed sourceA])))
 
 (def: (static-get proc)
-  (-> Text @.Proc)
+  (-> Text ///.Analysis)
   (function [analyse eval args]
     (case args
       (^ (list classC fieldC))
@@ -823,7 +824,7 @@
       (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +2 (list.size args))))))
 
 (def: (static-put proc)
-  (-> Text @.Proc)
+  (-> Text ///.Analysis)
   (function [analyse eval args]
     (case args
       (^ (list classC fieldC valueC))
@@ -847,7 +848,7 @@
       (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +3 (list.size args))))))
 
 (def: (virtual-get proc)
-  (-> Text @.Proc)
+  (-> Text ///.Analysis)
   (function [analyse eval args]
     (case args
       (^ (list classC fieldC objectC))
@@ -867,7 +868,7 @@
       (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +3 (list.size args))))))
 
 (def: (virtual-put proc)
-  (-> Text @.Proc)
+  (-> Text ///.Analysis)
   (function [analyse eval args]
     (case args
       (^ (list classC fieldC valueC objectC))
@@ -1111,7 +1112,7 @@
       (wrap argA))))
 
 (def: (invoke//static proc)
-  (-> Text @.Proc)
+  (-> Text ///.Analysis)
   (function [analyse eval args]
     (case (: (e.Error [Text Text (List [Text Code])])
              (s.run args ($_ p.seq s.text s.text (p.some (s.tuple (p.seq s.text s.any))))))
@@ -1128,7 +1129,7 @@
       (&.throw Wrong-Syntax (wrong-syntax proc args)))))
 
 (def: (invoke//virtual proc)
-  (-> Text @.Proc)
+  (-> Text ///.Analysis)
   (function [analyse eval args]
     (case (: (e.Error [Text Text Code (List [Text Code])])
              (s.run args ($_ p.seq s.text s.text s.any (p.some (s.tuple (p.seq s.text s.any))))))
@@ -1151,7 +1152,7 @@
       (&.throw Wrong-Syntax (wrong-syntax proc args)))))
 
 (def: (invoke//special proc)
-  (-> Text @.Proc)
+  (-> Text ///.Analysis)
   (function [analyse eval args]
     (case (: (e.Error [(List Code) [Text Text Code (List [Text Code]) Unit]])
              (p.run args ($_ p.seq s.text s.text s.any (p.some (s.tuple (p.seq s.text s.any))) s.end!)))
@@ -1168,7 +1169,7 @@
       (&.throw Wrong-Syntax (wrong-syntax proc args)))))
 
 (def: (invoke//interface proc)
-  (-> Text @.Proc)
+  (-> Text ///.Analysis)
   (function [analyse eval args]
     (case (: (e.Error [Text Text Code (List [Text Code])])
              (s.run args ($_ p.seq s.text s.text s.any (p.some (s.tuple (p.seq s.text s.any))))))
@@ -1189,7 +1190,7 @@
       (&.throw Wrong-Syntax (wrong-syntax proc args)))))
 
 (def: (invoke//constructor proc)
-  (-> Text @.Proc)
+  (-> Text ///.Analysis)
   (function [analyse eval args]
     (case (: (e.Error [Text (List [Text Code])])
              (s.run args ($_ p.seq s.text (p.some (s.tuple (p.seq s.text s.any))))))
diff --git a/new-luxc/source/luxc/lang/extension/statement.lux b/new-luxc/source/luxc/lang/extension/statement.lux
index 6e9530f38..7cb404b13 100644
--- a/new-luxc/source/luxc/lang/extension/statement.lux
+++ b/new-luxc/source/luxc/lang/extension/statement.lux
@@ -126,10 +126,10 @@
          _
          (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])
+  [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)
diff --git a/new-luxc/source/luxc/lang/extension/synthesis.lux b/new-luxc/source/luxc/lang/extension/synthesis.lux
index d034f2919..32d726796 100644
--- a/new-luxc/source/luxc/lang/extension/synthesis.lux
+++ b/new-luxc/source/luxc/lang/extension/synthesis.lux
@@ -5,5 +5,5 @@
   [//])
 
 (def: #export defaults
-  (Dict Text //.Expression)
+  (Dict Text //.Synthesis)
   (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
index d034f2919..663babdb6 100644
--- a/new-luxc/source/luxc/lang/extension/translation.lux
+++ b/new-luxc/source/luxc/lang/extension/translation.lux
@@ -5,5 +5,5 @@
   [//])
 
 (def: #export defaults
-  (Dict Text //.Expression)
+  (Dict Text //.Translation)
   (dict.new text.Hash<Text>))
diff --git a/new-luxc/source/luxc/lang/translation/procedure/host.jvm.lux b/new-luxc/source/luxc/lang/translation/procedure/host.jvm.lux
index f2f88904d..f737e81fc 100644
--- a/new-luxc/source/luxc/lang/translation/procedure/host.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/procedure/host.jvm.lux
@@ -21,7 +21,7 @@
                          ["$d" def]
                          ["$i" inst]))
               ["la" analysis]
-              (analysis (procedure ["&." host]))
+              (extension (analysis ["&." host]))
               ["ls" synthesis]))
   ["@" //common])