1 files changed, 68 insertions, 0 deletions
diff --git a/stdlib/source/lux/lang/compiler/extension.lux b/stdlib/source/lux/lang/compiler/extension.lux
new file mode 100644
index 000000000..28dcd4637
--- /dev/null
+++ b/stdlib/source/lux/lang/compiler/extension.lux
@@ -0,0 +1,68 @@
+(.module:
+  lux
+  (lux (control [monad #+ do]
+                ["ex" exception #+ exception:])
+       (data [error #+ Error]
+             [text]
+             (coll (dictionary ["dict" unordered #+ Dict]))))
+  [// #+ Eval]
+  [//compiler #+ Operation Compiler]
+  [//analysis #+ Analyser]
+  [//synthesis #+ Synthesizer]
+  [//translation #+ Translator])
+
+(type: #export (Extension i)
+  (#Base i)
+  (#Extension [Text (List (Extension i))]))
+
+(with-expansions [<Bundle> (as-is (Dict Text (-> Text (Handler s i o))))]
+  (type: #export (Handler s i o)
+    (-> (Compiler [s <Bundle>] (Extension i) (Extension o))
+        (Compiler [s <Bundle>] (List (Extension i)) (Extension o))))
+
+  (type: #export (Bundle s i o)
+    <Bundle>))
+
+(do-template [<name>]
+  [(exception: #export (<name> {name Text})
+     (ex.report ["Name" name]))]
+
+  [unknown-extension]
+  [cannot-overwrite-existing-extension]
+  )
+
+(def: #export (extend compiler)
+  (All [s i o]
+    (-> (Compiler s i o)
+        (Compiler [s (Bundle s i o)]
+                  (Extension i)
+                  (Extension o))))
+  (function (compiler' input (^@ stateE [stateB bundle]))
+    (case input
+      (#Base input')
+      (do error.Monad<Error>
+        [[stateB' output] (compiler input' stateB)]
+        (wrap [[stateB' bundle] (#Base output)]))
+      
+      (#Extension name parameters)
+      (case (dict.get name bundle)
+        (#.Some handler)
+        (do error.Monad<Error>
+          [[stateE' output] (handler name compiler' parameters stateE)]
+          (wrap [stateE' output]))
+        
+        #.None
+        (ex.throw unknown-extension name)))))
+
+(def: #export (install name handler)
+  (All [s i o]
+    (-> Text (-> Text (Handler s i o))
+        (Operation [s (Bundle s i o)] Any)))
+  (function (_ (^@ stateE [_ bundle]))
+    (if (dict.contains? name bundle)
+      (ex.throw cannot-overwrite-existing-extension name)
+      (ex.return [stateE (dict.put name handler bundle)]))))
+
+(def: #export fresh
+  Bundle
+  (dict.new text.Hash<Text>))