1 files changed, 108 insertions, 0 deletions
diff --git a/stdlib/source/library/lux/meta/type/nominal.lux b/stdlib/source/library/lux/meta/type/nominal.lux
new file mode 100644
index 000000000..1d5ce2602
--- /dev/null
+++ b/stdlib/source/library/lux/meta/type/nominal.lux
@@ -0,0 +1,108 @@
+(.require
+ [library
+  [lux (.except def)
+   ["[0]" meta]
+   [abstract
+    [monad (.only do)]]
+   [control
+    ["<>" parser (.use "[1]#[0]" monad)]]
+   [data
+    ["[0]" text (.use "[1]#[0]" equivalence)]
+    [collection
+     ["[0]" list (.use "[1]#[0]" functor)]]]
+   [meta
+    ["[0]" symbol (.use "[1]#[0]" codec)]
+    ["[0]" code (.only)
+     ["<[1]>" \\parser (.only Parser)]]
+    ["[0]" macro (.only)
+     ["[0]" context]
+     [syntax (.only syntax)
+      ["[0]" export]]]]]]
+ ["[0]" //])
+
+(type .public Frame
+  (Record
+   [#name Text
+    #type_vars (List Code)
+    #abstraction Code
+    #representation Code]))
+
+(context.def
+  [frames]
+  [expression]
+  [declaration]
+  Frame)
+
+(.def .public current
+  (Meta Frame)
+  (context.peek ..frames))
+
+(.def .public (specific name)
+  (-> Text (Meta Frame))
+  (context.search (|>> (the #name) (text#= name)) ..frames))
+
+(.def cast
+  (Parser [(Maybe Text) Code])
+  (<>.either (<>.and (<>.maybe <code>.local) <code>.any)
+             (<>.and (<>#in {.#None}) <code>.any)))
+
+(with_template [<name> <from> <to>]
+  [(.def .public <name>
+     (syntax (_ [[frame value] ..cast])
+       (do meta.monad
+         [[name type_vars abstraction representation] (when frame
+                                                        {.#Some frame}
+                                                        (..specific frame)
+                                                        
+                                                        {.#None}
+                                                        ..current)]
+         (in (list (` (//.as [(,* type_vars)] (, <from>) (, <to>)
+                             (, value))))))))]
+
+  [abstraction representation abstraction]
+  [representation abstraction representation]
+  )
+
+(.def declarationP
+  (Parser [Text (List Text)])
+  (<>.either (<code>.form (<>.and <code>.local (<>.some <code>.local)))
+             (<>.and <code>.local (at <>.monad in (list)))))
+
+(.def abstract
+  (Parser [Code [Text (List Text)] Code (List Code)])
+  (export.with
+    (all <>.and
+         ..declarationP
+         <code>.any
+         (<>.some <code>.any)
+         )))
+
+... TODO: Make sure the generated code always gets optimized away.
+... (This applies to uses of "abstraction" and "representation")
+(.def .public def
+  (syntax (_ [[export_policy [name type_vars] representation_type nominals]
+              ..abstract])
+    (do meta.monad
+      [current_module meta.current_module_name
+       g!Representation (macro.symbol "Representation")
+       .let [type_varsC (list#each code.local type_vars)
+             abstraction_declaration (` ((, (code.local name)) (,* type_varsC)))
+             representation_declaration (` ((, g!Representation) (,* type_varsC)))]]
+      (..declaration [name type_varsC abstraction_declaration representation_declaration]
+        (` (.these (type (, export_policy) (, abstraction_declaration)
+                     (Nominal (, (code.text (symbol#encoded [current_module name])))
+                              [(,* type_varsC)]))
+                   (type (, representation_declaration)
+                     (, representation_type))
+                   (,* nominals)))))))
+
+(.def selection
+  (Parser [(List Code) Code])
+  (<>.either (<>.and (<>#each (|>> list) <code>.any) <code>.any)
+             (<>.and (<>#in (list)) <code>.any)))
+
+(.def .public transmutation
+  (syntax (_ [[specific value] ..selection])
+    (in (list (` (.|> (, value)
+                      (..representation (,* specific))
+                      (..abstraction (,* specific))))))))