diff options
Diffstat (limited to 'stdlib/source/lux/host.jvm.lux')
| -rw-r--r-- | stdlib/source/lux/host.jvm.lux | 198 |
1 files changed, 98 insertions, 100 deletions
diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux index d8105ca0a..6c3f18b19 100644 --- a/stdlib/source/lux/host.jvm.lux +++ b/stdlib/source/lux/host.jvm.lux @@ -25,37 +25,37 @@ "To:" <to>)} (-> (primitive <from>) (primitive <to>)) - (_lux_proc ["jvm" <op>] [value]))] + (<op> value))] - [b2l "b2l" java.lang.Byte java.lang.Long] + [b2l "jvm b2l" java.lang.Byte java.lang.Long] - [s2l "s2l" java.lang.Short java.lang.Long] + [s2l "jvm s2l" java.lang.Short java.lang.Long] - [d2i "d2i" java.lang.Double java.lang.Integer] - [d2l "d2l" java.lang.Double java.lang.Long] - [d2f "d2f" java.lang.Double java.lang.Float] + [d2i "jvm d2i" java.lang.Double java.lang.Integer] + [d2l "jvm d2l" java.lang.Double java.lang.Long] + [d2f "jvm d2f" java.lang.Double java.lang.Float] - [f2i "f2i" java.lang.Float java.lang.Integer] - [f2l "f2l" java.lang.Float java.lang.Long] - [f2d "f2d" java.lang.Float java.lang.Double] + [f2i "jvm f2i" java.lang.Float java.lang.Integer] + [f2l "jvm f2l" java.lang.Float java.lang.Long] + [f2d "jvm f2d" java.lang.Float java.lang.Double] - [i2b "i2b" java.lang.Integer java.lang.Byte] - [i2s "i2s" java.lang.Integer java.lang.Short] - [i2l "i2l" java.lang.Integer java.lang.Long] - [i2f "i2f" java.lang.Integer java.lang.Float] - [i2d "i2d" java.lang.Integer java.lang.Double] - [i2c "i2c" java.lang.Integer java.lang.Character] - - [l2b "l2b" java.lang.Long java.lang.Byte] - [l2s "l2s" java.lang.Long java.lang.Short] - [l2i "l2i" java.lang.Long java.lang.Integer] - [l2f "l2f" java.lang.Long java.lang.Float] - [l2d "l2d" java.lang.Long java.lang.Double] - - [c2b "c2b" java.lang.Character java.lang.Byte] - [c2s "c2s" java.lang.Character java.lang.Short] - [c2i "c2i" java.lang.Character java.lang.Integer] - [c2l "c2l" java.lang.Character java.lang.Long] + [i2b "jvm i2b" java.lang.Integer java.lang.Byte] + [i2s "jvm i2s" java.lang.Integer java.lang.Short] + [i2l "jvm i2l" java.lang.Integer java.lang.Long] + [i2f "jvm i2f" java.lang.Integer java.lang.Float] + [i2d "jvm i2d" java.lang.Integer java.lang.Double] + [i2c "jvm i2c" java.lang.Integer java.lang.Character] + + [l2b "jvm l2b" java.lang.Long java.lang.Byte] + [l2s "jvm l2s" java.lang.Long java.lang.Short] + [l2i "jvm l2i" java.lang.Long java.lang.Integer] + [l2f "jvm l2f" java.lang.Long java.lang.Float] + [l2d "jvm l2d" java.lang.Long java.lang.Double] + + [c2b "jvm c2b" java.lang.Character java.lang.Byte] + [c2s "jvm c2s" java.lang.Character java.lang.Short] + [c2i "jvm c2i" java.lang.Character java.lang.Integer] + [c2l "jvm c2l" java.lang.Character java.lang.Long] ) ## [Utils] @@ -519,14 +519,14 @@ (do p;Monad<Parser> [#let [dotted-name (format "." field-name)] _ (s;this (code;symbol ["" dotted-name]))] - (wrap (`' (_lux_proc ["jvm" (~ (code;text (format "getstatic" ":" class-name ":" field-name)))] []))))) + (wrap (`' ((~ (code;text (format "jvm getstatic" ":" class-name ":" field-name)))))))) (def: (make-get-var-parser class-name field-name) (-> Text Text (Syntax Code)) (do p;Monad<Parser> [#let [dotted-name (format "." field-name)] _ (s;this (code;symbol ["" dotted-name]))] - (wrap (`' (_lux_proc ["jvm" (~ (code;text (format "getfield" ":" class-name ":" field-name)))] [_jvm_this]))))) + (wrap (`' ((~ (code;text (format "jvm getfield" ":" class-name ":" field-name))) _jvm_this))))) (def: (make-put-var-parser class-name field-name) (-> Text Text (Syntax Code)) @@ -534,7 +534,7 @@ [#let [dotted-name (format "." field-name)] [_ _ value] (: (Syntax [Unit Unit Code]) (s;form ($_ p;seq (s;this (' :=)) (s;this (code;symbol ["" dotted-name])) s;any)))] - (wrap (`' (_lux_proc ["jvm" (~ (code;text (format "putfield" ":" class-name ":" field-name)))] [_jvm_this (~ value)]))))) + (wrap (`' ((~ (code;text (format "jvm putfield" ":" class-name ":" field-name))) _jvm_this (~ value)))))) (def: (pre-walk-replace f input) (-> (-> Code Code) Code Code) @@ -580,8 +580,8 @@ [[_ args] (: (Syntax [Unit (List Code)]) (s;form ($_ p;seq (s;this (' .new!)) (s;tuple (p;exactly (list;size arg-decls) s;any))))) #let [arg-decls' (: (List Text) (list/map (. (simple-class$ params) product;right) arg-decls))]] - (wrap (` (;_lux_proc ["jvm" (~ (code;text (format "new" ":" class-name ":" (text;join-with "," arg-decls'))))] - [(~@ args)]))))) + (wrap (` ((~ (code;text (format "jvm new" ":" class-name ":" (text;join-with "," arg-decls')))) + (~@ args)))))) (def: (make-static-method-parser params class-name method-name arg-decls) (-> (List TypeParam) Text Text (List ArgDecl) (Syntax Code)) @@ -590,8 +590,8 @@ [_ args] (: (Syntax [Unit (List Code)]) (s;form ($_ p;seq (s;this (code;symbol ["" dotted-name])) (s;tuple (p;exactly (list;size arg-decls) s;any))))) #let [arg-decls' (: (List Text) (list/map (. (simple-class$ params) product;right) arg-decls))]] - (wrap (`' (;_lux_proc ["jvm" (~ (code;text (format "invokestatic" ":" class-name ":" method-name ":" (text;join-with "," arg-decls'))))] - [(~@ args)]))))) + (wrap (`' ((~ (code;text (format "jvm invokestatic" ":" class-name ":" method-name ":" (text;join-with "," arg-decls')))) + (~@ args)))))) (do-template [<name> <jvm-op>] [(def: (<name> params class-name method-name arg-decls) @@ -601,11 +601,11 @@ [_ args] (: (Syntax [Unit (List Code)]) (s;form ($_ p;seq (s;this (code;symbol ["" dotted-name])) (s;tuple (p;exactly (list;size arg-decls) s;any))))) #let [arg-decls' (: (List Text) (list/map (. (simple-class$ params) product;right) arg-decls))]] - (wrap (`' (;_lux_proc ["jvm" (~ (code;text (format <jvm-op> ":" class-name ":" method-name ":" (text;join-with "," arg-decls'))))] - [(~' _jvm_this) (~@ args)])))))] + (wrap (`' ((~ (code;text (format <jvm-op> ":" class-name ":" method-name ":" (text;join-with "," arg-decls')))) + (~' _jvm_this) (~@ args))))))] - [make-special-method-parser "invokespecial"] - [make-virtual-method-parser "invokevirtual"] + [make-special-method-parser "jvm invokespecial"] + [make-virtual-method-parser "jvm invokevirtual"] ) (def: (method->parser params class-name [[method-name _ _] meth-def]) @@ -1196,8 +1196,8 @@ args (s;tuple (p;exactly (list;size arg-decls) s;any)) #let [arg-decls' (: (List Text) (list/map (. (simple-class$ (list)) product;right) arg-decls))]] - (wrap (`' (;_lux_proc ["jvm" (~ (code;text (format "invokespecial" ":" (get@ #super-class-name super-class) ":" name ":" (text;join-with "," arg-decls'))))] - [(~' _jvm_this) (~@ args)]))))))] + (wrap (`' ((~ (code;text (format "jvm invokespecial" ":" (get@ #super-class-name super-class) ":" name ":" (text;join-with "," arg-decls')))) + (~' _jvm_this) (~@ args)))))))] (with-parens (spaced (list "override" (class-decl$ class-decl) @@ -1312,7 +1312,7 @@ replacer (parser->replacer (list/fold p;either (p;fail "") (list/compose field-parsers method-parsers))) - def-code (format "class:" + def-code (format "jvm class:" (spaced (list (class-decl$ class-decl) (super-class-decl$ super) (with-brackets (spaced (list/map super-class-decl$ interfaces))) @@ -1320,7 +1320,7 @@ (with-brackets (spaced (list/map annotation$ annotations))) (with-brackets (spaced (list/map field-decl$ fields))) (with-brackets (spaced (list/map (method-def$ replacer super) methods))))))]] - (wrap (list (` (;_lux_proc ["jvm" (~ (code;text def-code))] [])))))) + (wrap (list (` ((~ (code;text def-code)))))))) (syntax: #export (interface: [#let [imports (class-imports *compiler*)]] [class-decl (class-decl^ imports)] @@ -1335,12 +1335,12 @@ {#;doc (doc "Allows defining JVM interfaces." (interface: TestInterface ([] foo [boolean String] void #throws [Exception])))} - (let [def-code (format "interface:" + (let [def-code (format "jvm interface:" (spaced (list (class-decl$ class-decl) (with-brackets (spaced (list/map super-class-decl$ supers))) (with-brackets (spaced (list/map annotation$ annotations))) (spaced (list/map method-decl$ members)))))] - (wrap (list (` (;_lux_proc ["jvm" (~ (code;text def-code))] [])))) + (wrap (list (` ((~ (code;text def-code)))))) )) (syntax: #export (object [#let [imports (class-imports *compiler*)]] @@ -1361,17 +1361,17 @@ (exec (do-something some-value) []))) )} - (let [def-code (format "anon-class:" + (let [def-code (format "jvm anon-class:" (spaced (list (super-class-decl$ super) (with-brackets (spaced (list/map super-class-decl$ interfaces))) (with-brackets (spaced (list/map constructor-arg$ constructor-args))) (with-brackets (spaced (list/map (method-def$ id super) methods))))))] - (wrap (list (` (;_lux_proc ["jvm" (~ (code;text def-code))] [])))))) + (wrap (list (` ((~ (code;text def-code)))))))) (syntax: #export (null) {#;doc (doc "Null object reference." (null))} - (wrap (list (` (;_lux_proc ["jvm" "null"] []))))) + (wrap (list (` ("jvm null"))))) (def: #export (null? obj) {#;doc (doc "Test for null object reference." @@ -1382,7 +1382,7 @@ "=>" false)} (-> (primitive java.lang.Object) Bool) - (;_lux_proc ["jvm" "null?"] [obj])) + ("jvm null?" obj)) (syntax: #export (??? expr) {#;doc (doc "Takes a (potentially null) ObjectType reference and creates a (Maybe ObjectType) for it." @@ -1394,7 +1394,7 @@ (#;Some "YOLO"))} (with-gensyms [g!temp] (wrap (list (` (let [(~ g!temp) (~ expr)] - (if (;_lux_proc ["jvm" "null?"] [(~ g!temp)]) + (if ("jvm null?" (~ g!temp)) #;None (#;Some (~ g!temp))))))))) @@ -1413,7 +1413,7 @@ (~ g!value) #;None - (;_lux_proc ["jvm" "null"] [])})))))) + ("jvm null")})))))) (syntax: #export (try expr) {#;doc (doc "Covers the expression in a try-catch block." @@ -1421,7 +1421,7 @@ "If it fails, you get (#;Left error+stack-traces-as-text)." (try (risky-computation input)))} (with-gensyms [g!_] - (wrap (list (`' (_lux_proc ["lux" "try"] [(;function [(~ g!_)] (~ expr))])))))) + (wrap (list (`' ("lux try" (;function [(~ g!_)] (~ expr)))))))) (syntax: #export (instance? [#let [imports (class-imports *compiler*)]] [class (generic-type^ imports (list))] @@ -1431,14 +1431,14 @@ (instance? String "YOLO"))} (case obj (#;Some obj) - (wrap (list (` (;_lux_proc ["jvm" (~ (code;text (format "instanceof" ":" (simple-class$ (list) class))))] [(~ obj)])))) + (wrap (list (` ((~ (code;text (format "jvm instanceof" ":" (simple-class$ (list) class)))) (~ obj))))) #;None (do @ [g!obj (meta;gensym "obj")] (wrap (list (` (: (-> (primitive (~' java.lang.Object)) Bool) (function [(~ g!obj)] - (;_lux_proc ["jvm" (~ (code;text (format "instanceof" ":" (simple-class$ (list) class))))] [(~ g!obj)]))))))) + ((~ (code;text (format "jvm instanceof" ":" (simple-class$ (list) class)))) (~ g!obj)))))))) )) (syntax: #export (synchronized lock body) @@ -1447,7 +1447,7 @@ (exec (do-something ...) (do-something-else ...) (finish-the-computation ...))))} - (wrap (list (` (;_lux_proc ["jvm" "synchronized"] [(~ lock) (~ body)]))))) + (wrap (list (` ("jvm synchronized" (~ lock) (~ body)))))) (syntax: #export (do-to obj [methods (p;some partial-call^)]) {#;doc (doc "Call a variety of methods on an object; then return the object." @@ -1691,7 +1691,7 @@ (let [getter-name (code;symbol ["" (format method-prefix member-separator name)])] (` (def: (~ getter-name) (~ enum-type) - (;_lux_proc ["jvm" (~ (code;text (format "getstatic" ":" full-name ":" name)))] []))))))]] + ((~ (code;text (format "jvm getstatic" ":" full-name ":" name)))))))))]] (wrap (list/map getter-interop enum-members))) (#ConstructorDecl [commons _]) @@ -1699,8 +1699,8 @@ [return-type (member-def-return (get@ #import-member-mode commons) type-params class member) #let [def-name (code;symbol ["" (format method-prefix member-separator (get@ #import-member-alias commons))]) def-params (list (code;tuple arg-function-inputs)) - jvm-interop (|> (` (;_lux_proc ["jvm" (~ (code;text (format "new" ":" full-name ":" (text;join-with "," arg-classes))))] - [(~@ arg-method-inputs)])) + jvm-interop (|> (` ((~ (code;text (format "jvm new" ":" full-name ":" (text;join-with "," arg-classes)))) + (~@ arg-method-inputs))) (with-mode-inputs (get@ #import-member-mode commons) (list;zip2 arg-classes arg-function-inputs))) [return-type jvm-interop] (|> [return-type jvm-interop] @@ -1739,9 +1739,9 @@ ))) def-params (#;Cons (code;tuple arg-function-inputs) obj-ast) def-param-types (#;Cons (` [(~@ arg-types)]) class-ast) - jvm-interop (|> (` (;_lux_proc ["jvm" (~ (code;text (format jvm-op ":" full-name ":" import-method-name - ":" (text;join-with "," arg-classes))))] - [(~@ obj-ast) (~@ arg-method-inputs)])) + jvm-interop (|> (` ((~ (code;text (format "jvm " jvm-op ":" full-name ":" import-method-name + ":" (text;join-with "," arg-classes)))) + (~@ obj-ast) (~@ arg-method-inputs))) (with-mode-output (get@ #import-member-mode commons) (get@ #import-method-return method)) (with-mode-inputs (get@ #import-member-mode commons) @@ -1781,9 +1781,9 @@ getter-type (` (All [(~@ tvar-asts)] (~ getter-type))) getter-body (if import-field-static? (with-mode-field-get import-field-mode import-field-type - (` (;_lux_proc ["jvm" (~ (code;text (format "getstatic" ":" full-name ":" import-field-name)))] []))) + (` ((~ (code;text (format "jvm getstatic" ":" full-name ":" import-field-name)))))) (with-mode-field-get import-field-mode import-field-type - (` (;_lux_proc ["jvm" (~ (code;text (format "getfield" ":" full-name ":" import-field-name)))] [(~ g!obj)])))) + (` ((~ (code;text (format "jvm getfield" ":" full-name ":" import-field-name))) (~ g!obj))))) getter-body (if import-field-maybe? (` (??? (~ getter-body))) getter-body) @@ -1805,13 +1805,12 @@ setter-value (if import-field-maybe? (` (!!! (~ setter-value))) setter-value) - setter-command (format (if import-field-static? "putstatic" "putfield") + setter-command (format (if import-field-static? "jvm putstatic" "jvm putfield") ":" full-name ":" import-field-name)] (wrap (: (List Code) (list (` (def: (~ setter-call) (~ setter-type) - (io (;_lux_proc ["jvm" (~ (code;text setter-command))] - [(~ setter-value)]))))))))) + (io ((~ (code;text setter-command)) (~ setter-value)))))))))) (wrap (list)))] (wrap (list& getter-interop setter-interop))) ))) @@ -1828,11 +1827,11 @@ (def: (interface? class) (All [a] (-> (primitive java.lang.Class [a]) Bool)) - (_lux_proc ["jvm" "invokevirtual:java.lang.Class:isInterface:"] [class])) + ("jvm invokevirtual:java.lang.Class:isInterface:" class)) (def: (load-class class-name) (-> Text (Either Text (primitive java.lang.Class [(Ex [a] a)]))) - (try (_lux_proc ["jvm" "invokestatic:java.lang.Class:forName:java.lang.String"] [class-name]))) + (try ("jvm invokestatic:java.lang.Class:forName:java.lang.String" class-name))) (def: (class-kind [class-name _]) (-> ClassDecl (Meta ClassKind)) @@ -1911,23 +1910,23 @@ (case type (^template [<type> <array-op>] (^ (#GenericClass <type> (list))) - (wrap (list (` (;_lux_proc ["jvm" <array-op>] [(~ size)]))))) - (["boolean" "znewarray"] - ["byte" "bnewarray"] - ["short" "snewarray"] - ["int" "inewarray"] - ["long" "lnewarray"] - ["float" "fnewarray"] - ["double" "dnewarray"] - ["char" "cnewarray"]) + (wrap (list (` (<array-op> (~ size)))))) + (["boolean" "jvm znewarray"] + ["byte" "jvm bnewarray"] + ["short" "jvm snewarray"] + ["int" "jvm inewarray"] + ["long" "jvm lnewarray"] + ["float" "jvm fnewarray"] + ["double" "jvm dnewarray"] + ["char" "jvm cnewarray"]) _ - (wrap (list (` (;_lux_proc ["jvm" "anewarray"] [(~ (code;text (generic-type$ type))) (~ size)])))))) + (wrap (list (` ("jvm anewarray" (~ (code;text (generic-type$ type))) (~ size))))))) (syntax: #export (array-length array) {#;doc (doc "Gives the length of an array." (array-length my-array))} - (wrap (list (` (;_lux_proc ["jvm" "arraylength"] [(~ array)]))))) + (wrap (list (` ("jvm arraylength" (~ array)))))) (def: (type->class-name type) (-> Type (Meta Text)) @@ -1964,18 +1963,18 @@ (case array-jvm-type (^template [<type> <array-op>] <type> - (wrap (list (` (;_lux_proc ["jvm" <array-op>] [(~ array) (~ idx)]))))) - (["[Z" "zaload"] - ["[B" "baload"] - ["[S" "saload"] - ["[I" "iaload"] - ["[J" "jaload"] - ["[F" "faload"] - ["[D" "daload"] - ["[C" "caload"]) + (wrap (list (` (<array-op> (~ array) (~ idx)))))) + (["[Z" "jvm zaload"] + ["[B" "jvm baload"] + ["[S" "jvm saload"] + ["[I" "jvm iaload"] + ["[J" "jvm jaload"] + ["[F" "jvm faload"] + ["[D" "jvm daload"] + ["[C" "jvm caload"]) _ - (wrap (list (` (;_lux_proc ["jvm" "aaload"] [(~ array) (~ idx)])))))) + (wrap (list (` ("jvm aaload" (~ array) (~ idx))))))) _ (with-gensyms [g!array] @@ -1993,18 +1992,18 @@ (case array-jvm-type (^template [<type> <array-op>] <type> - (wrap (list (` (;_lux_proc ["jvm" <array-op>] [(~ array) (~ idx) (~ value)]))))) - (["[Z" "zastore"] - ["[B" "bastore"] - ["[S" "sastore"] - ["[I" "iastore"] - ["[J" "jastore"] - ["[F" "fastore"] - ["[D" "dastore"] - ["[C" "castore"]) + (wrap (list (` (<array-op> (~ array) (~ idx) (~ value)))))) + (["[Z" "jvm zastore"] + ["[B" "jvm bastore"] + ["[S" "jvm sastore"] + ["[I" "jvm iastore"] + ["[J" "jvm jastore"] + ["[F" "jvm fastore"] + ["[D" "jvm dastore"] + ["[C" "jvm castore"]) _ - (wrap (list (` (;_lux_proc ["jvm" "aastore"] [(~ array) (~ idx) (~ value)])))))) + (wrap (list (` ("jvm aastore" (~ array) (~ idx) (~ value))))))) _ (with-gensyms [g!array] @@ -2029,8 +2028,7 @@ (list (code;symbol ["" res-name]) res-ctor)) bindings)) closes (list/map (function [res] - (` (try (;_lux_proc ["jvm" "invokevirtual:java.io.Closeable:close:"] - [(~ (code;symbol ["" (product;left res)]))])))) + (` (try ("jvm invokevirtual:java.io.Closeable:close:" (~ (code;symbol ["" (product;left res)])))))) bindings)] (wrap (list (` (do Monad<IO> [(~@ inits) @@ -2042,7 +2040,7 @@ [type (generic-type^ imports (list))]) {#;doc (doc "Loads the class as a java.lang.Class object." (class-for java.lang.String))} - (wrap (list (` (;_lux_proc ["jvm" "load-class"] [(~ (code;text (simple-class$ (list) type)))]))))) + (wrap (list (` ("jvm load-class" (~ (code;text (simple-class$ (list) type)))))))) (def: get-compiler (Meta Compiler) |