1 files changed, 189 insertions, 0 deletions
diff --git a/stdlib/source/library/lux/target/jvm/type/lux.lux b/stdlib/source/library/lux/target/jvm/type/lux.lux
new file mode 100644
index 000000000..45fd34c8d
--- /dev/null
+++ b/stdlib/source/library/lux/target/jvm/type/lux.lux
@@ -0,0 +1,189 @@
+(.module:
+  [library
+   [lux (#- int char type primitive)
+    [abstract
+     ["." monad (#+ do)]]
+    [control
+     ["." try]
+     ["." exception (#+ exception:)]
+     ["<>" parser ("#\." monad)
+      ["<t>" text (#+ Parser)]]]
+    [data
+     ["." product]
+     ["." text ("#\." equivalence)
+      ["%" format (#+ format)]]
+     [collection
+      ["." array]
+      ["." dictionary (#+ Dictionary)]]]
+    [type
+     abstract
+     ["." check (#+ Check) ("#\." monad)]]]]
+  ["." //
+   [category (#+ Void Value Return Method Primitive Object Class Array Var Parameter)]
+   ["#." descriptor]
+   ["#." signature]
+   ["#." reflection]
+   ["#." parser]
+   ["/#" // #_
+    [encoding
+     ["#." name]]]])
+
+(template [<name>]
+  [(abstract: #export (<name> class) Any)]
+
+  [Lower] [Upper]
+  )
+
+(type: #export Mapping
+  (Dictionary Text Type))
+
+(def: #export fresh
+  Mapping
+  (dictionary.new text.hash))
+
+(exception: #export (unknown_var {var Text})
+  (exception.report
+   ["Var" (%.text var)]))
+
+(def: void
+  (Parser (Check Type))
+  (<>.after //parser.void
+            (<>\wrap (check\wrap .Any))))
+
+(template [<name> <parser> <reflection>]
+  [(def: <name>
+     (Parser (Check Type))
+     (<>.after <parser>
+               (<>\wrap (check\wrap (#.Primitive (//reflection.reflection <reflection>) #.Nil)))))]
+
+  [boolean //parser.boolean //reflection.boolean]
+  [byte //parser.byte //reflection.byte]
+  [short //parser.short //reflection.short]
+  [int //parser.int //reflection.int]
+  [long //parser.long //reflection.long]
+  [float //parser.float //reflection.float]
+  [double //parser.double //reflection.double]
+  [char //parser.char //reflection.char]
+  )
+
+(def: primitive
+  (Parser (Check Type))
+  ($_ <>.either
+      ..boolean
+      ..byte
+      ..short
+      ..int
+      ..long
+      ..float
+      ..double
+      ..char
+      ))
+
+(def: wildcard
+  (Parser (Check Type))
+  (<>.after //parser.wildcard
+            (<>\wrap (check\map product.right
+                                check.existential))))
+
+(def: (var mapping)
+  (-> Mapping (Parser (Check Type)))
+  (do <>.monad
+    [var //parser.var']
+    (wrap (case (dictionary.get var mapping)
+            #.None
+            (check.throw ..unknown_var [var])
+            
+            (#.Some type)
+            (check\wrap type)))))
+
+(def: (class' parameter)
+  (-> (Parser (Check Type)) (Parser (Check Type)))
+  (|> (do <>.monad
+        [name //parser.class_name
+         parameters (|> (<>.some parameter)
+                        (<>.after (<t>.this //signature.parameters_start))
+                        (<>.before (<t>.this //signature.parameters_end))
+                        (<>.default (list)))]
+        (wrap (do {! check.monad}
+                [parameters (monad.seq ! parameters)]
+                (wrap (#.Primitive name parameters)))))
+      (<>.after (<t>.this //descriptor.class_prefix))
+      (<>.before (<t>.this //descriptor.class_suffix))))
+
+(template [<name> <prefix> <constructor>]
+  [(def: <name>
+     (-> (Parser (Check Type)) (Parser (Check Type)))
+     (|> (<>.after (<t>.this <prefix>))
+         ## TODO: Re-enable Lower and Upper, instead of using the simplified limit.
+         ## (<>\map (check\map (|>> <ctor> .type)))
+         ))]
+
+  [lower //signature.lower_prefix ..Lower]
+  [upper //signature.upper_prefix ..Upper]
+  )
+
+(def: (parameter mapping)
+  (-> Mapping (Parser (Check Type)))
+  (<>.rec
+   (function (_ parameter)
+     (let [class (..class' parameter)]
+       ($_ <>.either
+           (..var mapping)
+           ..wildcard
+           (..lower class)
+           (..upper class)
+           class
+           )))))
+
+(def: #export class
+  (-> Mapping (Parser (Check Type)))
+  (|>> ..parameter ..class'))
+
+(def: array
+  (-> (Parser (Check Type)) (Parser (Check Type)))
+  (|>> (<>\map (check\map (function (_ elementT)
+                            (case elementT
+                              (#.Primitive name #.Nil)
+                              (if (`` (or (~~ (template [<reflection>]
+                                                [(text\= (//reflection.reflection <reflection>) name)]
+
+                                                [//reflection.boolean]
+                                                [//reflection.byte]
+                                                [//reflection.short]
+                                                [//reflection.int]
+                                                [//reflection.long]
+                                                [//reflection.float]
+                                                [//reflection.double]
+                                                [//reflection.char]))))
+                                (#.Primitive (|> name //reflection.class //reflection.array //reflection.reflection) #.Nil)
+                                (|> elementT array.Array .type))
+
+                              _
+                              (|> elementT array.Array .type)))))
+       (<>.after (<t>.this //descriptor.array_prefix))))
+
+(def: #export (type mapping)
+  (-> Mapping (Parser (Check Type)))
+  (<>.rec
+   (function (_ type)
+     ($_ <>.either
+         ..primitive
+         (parameter mapping)
+         (..array type)
+         ))))
+
+(def: #export (return mapping)
+  (-> Mapping (Parser (Check Type)))
+  ($_ <>.either
+      ..void
+      (..type mapping)
+      ))
+
+(def: #export (check operation input)
+  (All [a] (-> (Parser (Check a)) Text (Check a)))
+  (case (<t>.run operation input)
+    (#try.Success check)
+    check
+    
+    (#try.Failure error)
+    (check.fail error)))