1 files changed, 74 insertions, 0 deletions
diff --git a/stdlib/source/lux/host/jvm/modifier.lux b/stdlib/source/lux/host/jvm/modifier.lux
new file mode 100644
index 000000000..5c9280164
--- /dev/null
+++ b/stdlib/source/lux/host/jvm/modifier.lux
@@ -0,0 +1,74 @@
+(.module:
+  [lux #*
+   [control
+    ["." monoid]
+    ["." parser]]
+   [data
+    ["." number
+     ["." i64]]
+    [format
+     ["." binary]]
+    [collection
+     [list ("list/." Functor<List>)]]]
+   [type
+    ["." abstract]]
+   [macro (#+ with-gensyms)
+    ["." code]
+    ["s" syntax (#+ Syntax syntax:)]]]
+  [//
+   ["//." encoding]])
+
+(type: Modifier
+  {#code Text
+   #name Text})
+
+(def: modifier
+  (Syntax Modifier)
+  (s.tuple (parser.and s.text
+                       s.local-identifier)))
+
+(def: (code modifier)
+  (-> Modifier Code)
+  (code.tuple (list (code.text (get@ #code modifier))
+                    (code.local-identifier (get@ #name modifier)))))
+
+(syntax: #export (modifiers: {options (parser.many ..modifier)})
+  (with-gensyms [g!parameter g!subject g!<name> g!<code>]
+    (let [nameC (' Modifier)
+          combineC (' combine)
+          emptyC (' empty)
+          typeC (` (abstract.abstract: (~' #export) (~ nameC)
+                     {}
+
+                     //encoding.U2
+
+                     (.def: (~' #export) (~' code)
+                       (.-> (~ nameC) //encoding.U2)
+                       (.|>> (~' :representation)))
+
+                     (.def: (~' #export) ((~ combineC) (~ g!parameter) (~ g!subject))
+                       (.-> (~ nameC) (~ nameC) (~ nameC))
+                       ((~' :abstraction) (//encoding.to-u2 (i64.and (//encoding.from-u2 ((~' :representation) (~ g!parameter)))
+                                                                     (//encoding.from-u2 ((~' :representation) (~ g!subject)))))))
+
+                     (.do-template [(~ g!<code>) (~ g!<name>)]
+                       [(.def: (~' #export) (~ g!<name>)
+                          (~ nameC)
+                          (.|> (number.hex (~ g!<code>)) //encoding.to-u2 (~' :abstraction)))]
+
+                       ["0000" (~ emptyC)]
+                       (~+ (list/map ..code options))
+                       )
+
+                     (.def: (~' #export) (~' format)
+                       (binary.Format (~ nameC))
+                       (.let [(.^open "_/.") //encoding.u2-format]
+                         {#binary.reader (|> (~' _/reader)
+                                             (:: parser.Functor<Parser> (~' map)
+                                                 (|>> (~' :abstraction))))
+                          #binary.writer (|>> (~' :representation)
+                                              (~' _/writer))}))))
+          monoidC (` (.structure: (~' #export) (~' _) (monoid.Monoid (~ nameC))
+                       (.def: (~' identity) (~ emptyC))
+                       (.def: (~' compose) (~ combineC))))]
+      (wrap (list typeC monoidC)))))