1 files changed, 135 insertions, 0 deletions
diff --git a/stdlib/source/library/lux/meta/code.lux b/stdlib/source/library/lux/meta/code.lux
new file mode 100644
index 000000000..dc182b124
--- /dev/null
+++ b/stdlib/source/library/lux/meta/code.lux
@@ -0,0 +1,135 @@
+(.require
+ [library
+  [lux (.except nat int rev local global symbol)
+   [abstract
+    [equivalence (.only Equivalence)]]
+   [data
+    ["[0]" product]
+    ["[0]" bit]
+    ["[0]" text (.use "[1]#[0]" monoid equivalence)]
+    [collection
+     ["[0]" list (.use "[1]#[0]" functor mix)]]]
+   [macro
+    ["^" pattern]]
+   [math
+    [number
+     ["[0]" nat]
+     ["[0]" int]
+     ["[0]" rev]
+     ["[0]" frac]]]
+   [meta
+    ["[0]" location]
+    ["[0]" symbol]]]])
+
+... (type (Code' w)
+...   {.#Bit Bit}
+...   {.#Nat Nat}
+...   {.#Int Int}
+...   {.#Rev Rev}
+...   {.#Frac Frac}
+...   {.#Text Text}
+...   {.#Symbol Symbol}
+...   {.#Form (List (w (Code' w)))}
+...   {.#Variant (List (w (Code' w)))}
+...   {.#Tuple (List (w (Code' w)))})
+
+... (type Code
+...   (Ann Location (Code' (Ann Location))))
+
+(with_template [<name> <type> <tag>]
+  [(def .public (<name> x)
+     (-> <type> Code)
+     [location.dummy {<tag> x}])]
+  
+  [bit     Bit         .#Bit]
+  [nat     Nat         .#Nat]
+  [int     Int         .#Int]
+  [rev     Rev         .#Rev]
+  [frac    Frac        .#Frac]
+  [text    Text        .#Text]
+  [symbol  Symbol      .#Symbol]
+  [form    (List Code) .#Form]
+  [variant (List Code) .#Variant]
+  [tuple   (List Code) .#Tuple]
+  )
+
+(with_template [<name> <tag>]
+  [(def .public (<name> name)
+     (-> Text Code)
+     [location.dummy {<tag> ["" name]}])]
+
+  [local .#Symbol])
+
+(def .public equivalence
+  (Equivalence Code)
+  (implementation
+   (def (= x y)
+     (case [x y]
+       (^.with_template [<tag> <eq>]
+         [[[_ {<tag> x'}] [_ {<tag> y'}]]
+          (at <eq> = x' y')])
+       ([.#Bit    bit.equivalence]
+        [.#Nat    nat.equivalence]
+        [.#Int    int.equivalence]
+        [.#Rev    rev.equivalence]
+        [.#Frac   frac.equivalence]
+        [.#Text   text.equivalence]
+        [.#Symbol symbol.equivalence])
+
+       (^.with_template [<tag>]
+         [[[_ {<tag> xs'}] [_ {<tag> ys'}]]
+          (at (list.equivalence =) = xs' ys')])
+       ([.#Form]
+        [.#Variant]
+        [.#Tuple])
+       
+       _
+       false))))
+
+(def .public (format ast)
+  (-> Code Text)
+  (case ast
+    (^.with_template [<tag> <struct>]
+      [[_ {<tag> value}]
+       (at <struct> encoded value)])
+    ([.#Bit    bit.codec]
+     [.#Nat    nat.decimal]
+     [.#Int    int.decimal]
+     [.#Rev    rev.decimal]
+     [.#Frac   frac.decimal]
+     [.#Symbol symbol.codec])
+
+    [_ {.#Text value}]
+    (text.format value)
+
+    (^.with_template [<tag> <open> <close>]
+      [[_ {<tag> members}]
+       (all text#composite
+            <open>
+            (list#mix (function (_ next prev)
+                        (let [next (format next)]
+                          (if (text#= "" prev)
+                            next
+                            (all text#composite prev " " next))))
+                      ""
+                      members)
+            <close>)])
+    ([.#Form  "(" ")"]
+     [.#Variant "{" "}"]
+     [.#Tuple "[" "]"])
+    ))
+
+(def .public (replaced original substitute ast)
+  (-> Code Code Code Code)
+  (if (at ..equivalence = original ast)
+    substitute
+    (case ast
+      (^.with_template [<tag>]
+        [[location {<tag> parts}]
+         [location {<tag> (list#each (replaced original substitute) parts)}]])
+      ([.#Form]
+       [.#Variant]
+       [.#Tuple])
+
+      _
+      ast)))