diff options
Diffstat (limited to 'stdlib/source/lux/target/jvm/type.lux')
-rw-r--r-- | stdlib/source/lux/target/jvm/type.lux | 205 |
1 files changed, 205 insertions, 0 deletions
diff --git a/stdlib/source/lux/target/jvm/type.lux b/stdlib/source/lux/target/jvm/type.lux new file mode 100644 index 000000000..23925e468 --- /dev/null +++ b/stdlib/source/lux/target/jvm/type.lux @@ -0,0 +1,205 @@ +(.module: + [lux (#- Type int char) + [data + ["." maybe ("#@." functor)] + ["." text + format] + [collection + ["." list ("#@." functor)]]]]) + +(def: array-prefix "[") +(def: binary-void-name "V") +(def: binary-boolean-name "Z") +(def: binary-byte-name "B") +(def: binary-short-name "S") +(def: binary-int-name "I") +(def: binary-long-name "J") +(def: binary-float-name "F") +(def: binary-double-name "D") +(def: binary-char-name "C") +(def: binary-object-prefix "L") +(def: binary-object-suffix ";") +(def: object-class "java.lang.Object") + +(type: #export Bound + #Upper + #Lower) + +(type: #export Primitive + #Boolean + #Byte + #Short + #Int + #Long + #Float + #Double + #Char) + +(type: #export #rec Generic + (#Var Text) + (#Wildcard (Maybe [Bound Generic])) + (#Class Text (List Generic))) + +(type: #export Class + [Text (List Generic)]) + +(type: #export Parameter + [Text Class (List Class)]) + +(type: #export #rec Type + (#Primitive Primitive) + (#Generic Generic) + (#Array Type)) + +(type: #export Method + {#args (List Type) + #return (Maybe Type) + #exceptions (List Generic)}) + +(template [<name> <primitive>] + [(def: #export <name> Type (#Primitive <primitive>))] + + [boolean #Boolean] + [byte #Byte] + [short #Short] + [int #Int] + [long #Long] + [float #Float] + [double #Double] + [char #Char] + ) + +(template: #export (class name params) + (#..Generic (#..Class name params))) + +(template: #export (var name) + (#..Generic (#..Var name))) + +(template: #export (wildcard bound) + (#..Generic (#..Wildcard bound))) + +(def: #export (array depth elemT) + (-> Nat Type Type) + (case depth + 0 elemT + _ (#Array (array (dec depth) elemT)))) + +(def: #export binary-name + (-> Text Text) + (text.replace-all "." "/")) + +(def: #export (descriptor type) + (-> Type Text) + (case type + (#Primitive prim) + (case prim + #Boolean ..binary-boolean-name + #Byte ..binary-byte-name + #Short ..binary-short-name + #Int ..binary-int-name + #Long ..binary-long-name + #Float ..binary-float-name + #Double ..binary-double-name + #Char ..binary-char-name) + + (#Array sub) + (format ..array-prefix (descriptor sub)) + + (#Generic generic) + (case generic + (#Class class params) + (format ..binary-object-prefix (binary-name class) ..binary-object-suffix) + + (^or (#Var name) (#Wildcard ?bound)) + (descriptor (#Generic (#Class ..object-class (list))))) + )) + +(def: #export (class-name type) + (-> Type (Maybe Text)) + (case type + (#Primitive prim) + #.None + + (#Array sub) + (#.Some (descriptor type)) + + (#Generic generic) + (case generic + (#Class class params) + (#.Some class) + + (^or (#Var name) (#Wildcard ?bound)) + (#.Some ..object-class)) + )) + +(def: #export (signature type) + (-> Type Text) + (case type + (#Primitive prim) + (case prim + #Boolean ..binary-boolean-name + #Byte ..binary-byte-name + #Short ..binary-short-name + #Int ..binary-int-name + #Long ..binary-long-name + #Float ..binary-float-name + #Double ..binary-double-name + #Char ..binary-char-name) + + (#Array sub) + (format ..array-prefix (signature sub)) + + (#Generic generic) + (case generic + (#Class class params) + (let [=params (if (list.empty? params) + "" + (format "<" + (|> params + (list@map (|>> #Generic signature)) + (text.join-with "")) + ">"))] + (format ..binary-object-prefix (binary-name class) =params ..binary-object-suffix)) + + (#Var name) + (format "T" name ..binary-object-suffix) + + (#Wildcard #.None) + "*" + + (^template [<tag> <prefix>] + (#Wildcard (#.Some [<tag> bound])) + (format <prefix> (signature (#Generic bound)))) + ([#Upper "+"] + [#Lower "-"])) + )) + +(def: #export (method args return exceptions) + (-> (List Type) (Maybe Type) (List Generic) Method) + {#args args #return return #exceptions exceptions}) + +(def: method-args + (text.enclose ["(" ")"])) + +(def: #export (method-descriptor method) + (-> Method Text) + (format (|> (get@ #args method) (list@map descriptor) (text.join-with "") ..method-args) + (case (get@ #return method) + #.None + ..binary-void-name + + (#.Some return) + (descriptor return)))) + +(def: #export (method-signature method) + (-> Method Text) + (format (|> (get@ #args method) (list@map signature) (text.join-with "") ..method-args) + (case (get@ #return method) + #.None + ..binary-void-name + + (#.Some return) + (signature return)) + (|> (get@ #exceptions method) + (list@map (|>> #Generic signature (format "^"))) + (text.join-with "")))) |