Extension-related fixes.

7 files changed, 56 insertions, 33 deletions

diff --git a/stdlib/source/lux/compiler/default.lux b/stdlib/source/lux/compiler/default.lux
index ac3fb7aa8..5b4a1a153 100644
--- a/stdlib/source/lux/compiler/default.lux
+++ b/stdlib/source/lux/compiler/default.lux
@@ -27,7 +27,7 @@
     ["." analysis
      ["." module]
      [".A" expression]]
-    ["." translation (#+ Host)]
+    ["." translation (#+ Host Bundle)]
     ["." statement
      [".S" total]]]]
   ## (luxc [cache]
@@ -77,7 +77,8 @@
 
 (with-expansions [<Platform> (as-is (Platform fs anchor expression statement))
                   <Operation> (as-is (statement.Operation anchor expression statement Any))
-                  <Compiler> (as-is (statement.State+ anchor expression statement))]
+                  <Compiler> (as-is (statement.State+ anchor expression statement))
+                  <Bundle> (as-is (Bundle anchor expression statement))]
   
   (def: (begin-module-compilation module-name source)
     (All [anchor expression statement]
@@ -137,14 +138,15 @@
                   {<Operation>
                    (perform-module-compilation (get@ #cli.module configuration) source)}))))
 
-  (def: #export (initialize platform configuration)
+  (def: #export (initialize platform configuration translation-bundle)
     (All [fs anchor expression statement]
-      (-> <Platform> Configuration (fs <Compiler>)))
+      (-> <Platform> Configuration <Bundle> (fs <Compiler>)))
     (|> platform
         (get@ #runtime)
         statement.lift-translation
         (phase.run' (init.state (get@ #host platform)
-                                (get@ #phase platform)))
+                                (get@ #phase platform)
+                                translation-bundle))
         (:: error.Functor<Error> map product.left)
         (:: (get@ #file-system platform) lift))
     
@@ -174,11 +176,11 @@
     ##   (io.fail error))
     )
 
-  (def: #export (compile platform configuration)
+  (def: #export (compile platform configuration translation-bundle)
     (All [fs anchor expression statement]
-      (-> <Platform> Configuration (fs Any)))
+      (-> <Platform> Configuration <Bundle> (fs Any)))
     (do (:: (get@ #file-system platform) &monad)
-      [compiler (initialize platform configuration)
+      [compiler (initialize platform configuration translation-bundle)
        _ (compile-module platform (set@ #cli.module ..prelude configuration) compiler)
        _ (compile-module platform configuration compiler)
        ## _ (cache/io.clean target ...)
diff --git a/stdlib/source/lux/compiler/default/init.lux b/stdlib/source/lux/compiler/default/init.lux
index 96464ed2a..07aa1217e 100644
--- a/stdlib/source/lux/compiler/default/init.lux
+++ b/stdlib/source/lux/compiler/default/init.lux
@@ -16,7 +16,6 @@
     ["." extension
      [".E" analysis]
      [".E" synthesis]
-     [".E" translation]
      [".E" statement]]]
    [//
     ["." host]]])
@@ -72,13 +71,14 @@
    #.extensions      []
    #.host            host})
 
-(def: #export (state host translate)
+(def: #export (state host translate translation-bundle)
   (All [anchor expression statement]
     (-> (Host expression statement)
         (translation.Phase anchor expression statement)
+        (translation.Bundle anchor expression statement)
         (statement.State+ anchor expression statement)))
   (let [synthesis-state [synthesisE.bundle synthesis.init]
-        translation-state [translationE.bundle (translation.state host)]
+        translation-state [translation-bundle (translation.state host)]
         eval (evaluation.evaluator synthesis-state translation-state translate)
         analysis-state [(analysisE.bundle eval) (..compiler host)]]
     [statementE.bundle
diff --git a/stdlib/source/lux/compiler/default/phase/analysis/expression.lux b/stdlib/source/lux/compiler/default/phase/analysis/expression.lux
index 0f01b48da..ed2f81735 100644
--- a/stdlib/source/lux/compiler/default/phase/analysis/expression.lux
+++ b/stdlib/source/lux/compiler/default/phase/analysis/expression.lux
@@ -103,7 +103,7 @@
           (case.case compile input branches)
 
           (^ (#.Form (list& [_ (#.Text extension-name)] extension-args)))
-          (extension.apply compile [extension-name extension-args])
+          (extension.apply "Analysis" compile [extension-name extension-args])
 
           (^ (#.Form (list [_ (#.Tuple (list [_ (#.Identifier ["" function-name])]
                                              [_ (#.Identifier ["" arg-name])]))]
diff --git a/stdlib/source/lux/compiler/default/phase/extension.lux b/stdlib/source/lux/compiler/default/phase/extension.lux
index 56e8560f0..99c7152c7 100644
--- a/stdlib/source/lux/compiler/default/phase/extension.lux
+++ b/stdlib/source/lux/compiler/default/phase/extension.lux
@@ -8,6 +8,7 @@
     ["." text
      format]
     [collection
+     [list ("list/." Functor<List>)]
      ["." dictionary (#+ Dictionary)]]]
    ["." function]]
   ["." //])
@@ -38,11 +39,18 @@
   [(exception: #export (<name> {name Text})
      (ex.report ["Extension" (%t name)]))]
 
-  [unknown]
   [cannot-overwrite]
   [invalid-syntax]
   )
 
+(exception: #export [s i o] (unknown {where Text} {name Text} {bundle (Bundle s i o)})
+  (ex.report ["Where" (%t where)]
+             ["Extension" (%t name)]
+             ["Available" (|> bundle
+                              dictionary.keys
+                              (list/map (|>> %t (format "\n\t")))
+                              (text.join-with ""))]))
+
 (exception: #export (incorrect-arity {name Text} {arity Nat} {args Nat})
   (ex.report ["Extension" (%t name)]
              ["Expected" (%n arity)]
@@ -57,13 +65,13 @@
       (#error.Success [[(dictionary.put name handler bundle) state]
                        []]))))
 
-(def: #export (apply phase [name parameters])
+(def: #export (apply where phase [name parameters])
   (All [s i o]
-    (-> (Phase s i o) (Extension i) (Operation s i o o)))
+    (-> Text (Phase s i o) (Extension i) (Operation s i o o)))
   (function (_ (^@ stateE [bundle state]))
     (case (dictionary.get name bundle)
       #.None
-      (ex.throw unknown name)
+      (ex.throw unknown [where name bundle])
       
       (#.Some handler)
       ((handler name phase) parameters stateE))))
diff --git a/stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux b/stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux
index 65fcf8550..884ef7302 100644
--- a/stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux
+++ b/stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux
@@ -147,29 +147,30 @@
           (bundle.install "exit" (unary Int Nothing))
           (bundle.install "current-time" (nullary Int)))))
 
-(def: bundle::bit
+(def: I64* (type (I64 Any)))
+
+(def: bundle::i64
   Bundle
-  (<| (bundle.prefix "bit")
+  (<| (bundle.prefix "i64")
       (|> bundle.empty
-          (bundle.install "and" (binary Nat Nat Nat))
-          (bundle.install "or" (binary Nat Nat Nat))
-          (bundle.install "xor" (binary Nat Nat Nat))
-          (bundle.install "left-shift" (binary Nat Nat Nat))
-          (bundle.install "logical-right-shift" (binary Nat Nat Nat))
-          (bundle.install "arithmetic-right-shift" (binary Int Nat Int))
-          )))
+          (bundle.install "and" (binary I64* I64* I64))
+          (bundle.install "or" (binary I64* I64* I64))
+          (bundle.install "xor" (binary I64* I64* I64))
+          (bundle.install "left-shift" (binary Nat I64* I64))
+          (bundle.install "logical-right-shift" (binary Nat I64* I64))
+          (bundle.install "arithmetic-right-shift" (binary Nat I64* I64))
+          (bundle.install "+" (binary I64* I64* I64))
+          (bundle.install "-" (binary I64* I64* I64))
+          (bundle.install "=" (binary I64* I64* Bit)))))
 
 (def: bundle::int
   Bundle
   (<| (bundle.prefix "int")
       (|> bundle.empty
-          (bundle.install "+" (binary Int Int Int))
-          (bundle.install "-" (binary Int Int Int))
           (bundle.install "*" (binary Int Int Int))
           (bundle.install "/" (binary Int Int Int))
           (bundle.install "%" (binary Int Int Int))
-          (bundle.install "=" (binary Int Int Bit))
-          (bundle.install "<" (binary Int Int Bit))
+          (bundle.install "<" (binary Int Int Int))
           (bundle.install "to-frac" (unary Int Frac))
           (bundle.install "char" (unary Int Text)))))
 
@@ -210,7 +211,7 @@
   (<| (bundle.prefix "lux")
       (|> bundle.empty
           (dictionary.merge (bundle::lux eval))
-          (dictionary.merge bundle::bit)
+          (dictionary.merge bundle::i64)
           (dictionary.merge bundle::int)
           (dictionary.merge bundle::frac)
           (dictionary.merge bundle::text)
diff --git a/stdlib/source/lux/compiler/default/phase/statement/total.lux b/stdlib/source/lux/compiler/default/phase/statement/total.lux
index 967f07294..8b81a134c 100644
--- a/stdlib/source/lux/compiler/default/phase/statement/total.lux
+++ b/stdlib/source/lux/compiler/default/phase/statement/total.lux
@@ -28,7 +28,7 @@
   Phase
   (case code
     (^ [_ (#.Form (list& [_ (#.Text name)] inputs))])
-    (extension.apply phase [name inputs])
+    (extension.apply "Statement" phase [name inputs])
 
     (^ [_ (#.Form (list& macro inputs))])
     (do ///.Monad<Operation>
diff --git a/stdlib/source/lux/compiler/default/phase/synthesis/expression.lux b/stdlib/source/lux/compiler/default/phase/synthesis/expression.lux
index 6cdd9b6fc..0d15ae463 100644
--- a/stdlib/source/lux/compiler/default/phase/synthesis/expression.lux
+++ b/stdlib/source/lux/compiler/default/phase/synthesis/expression.lux
@@ -1,9 +1,11 @@
 (.module:
   [lux (#- primitive)
    [control
-    ["." monad (#+ do)]]
+    ["." monad (#+ do)]
+    pipe]
    [data
     ["." maybe]
+    ["." error]
     [collection
      ["." list ("list/." Functor<List>)]
      ["." dictionary (#+ Dictionary)]]]]
@@ -70,5 +72,15 @@
     (function.abstraction phase environmentA bodyA)
 
     (#analysis.Extension name args)
-    (extension.apply phase [name args])
+    (function (_ state)
+      (|> (extension.apply "Synthesis" phase [name args])
+          (///.run' state)
+          (case> (#error.Success output)
+                 (#error.Success output)
+                 
+                 (#error.Error error)
+                 (<| (///.run' state)
+                     (do ///.Monad<Operation>
+                       [argsS+ (monad.map @ phase args)]
+                       (wrap (#//.Extension [name argsS+])))))))
     ))