diff options
Diffstat (limited to 'source')
| -rw-r--r-- | source/lux.lux | 27 | ||||
| -rw-r--r-- | source/lux/data/char.lux | 2 | ||||
| -rw-r--r-- | source/lux/data/io.lux | 4 | ||||
| -rw-r--r-- | source/lux/data/number.lux | 14 | ||||
| -rw-r--r-- | source/lux/data/text.lux | 61 | ||||
| -rw-r--r-- | source/lux/host/jvm.lux (renamed from source/lux/host/java.lux) | 178 | ||||
| -rw-r--r-- | source/lux/math.lux | 50 | ||||
| -rw-r--r-- | source/lux/meta/syntax.lux | 2 | ||||
| -rw-r--r-- | source/program.lux | 2 |
9 files changed, 145 insertions, 195 deletions
diff --git a/source/lux.lux b/source/lux.lux index 8f7e4fa04..c51929635 100644 --- a/source/lux.lux +++ b/source/lux.lux @@ -8,7 +8,7 @@ ## First things first, must define functions (_jvm_interface "Function" [] - (apply ["java.lang.Object"] "java.lang.Object" ["public" "abstract"])) + ("apply" ["java.lang.Object"] "java.lang.Object" ["public" "abstract"])) ## Basic types (_lux_def Bool (#DataT "java.lang.Boolean")) @@ -860,8 +860,9 @@ [true (#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS ["" "~"])]) (#Cons [unquoted #Nil])]))])] unquoted - [_ (#Meta [_ (#FormS elems)])] - (splice replace? (untemplate replace? subst) (tag$ ["lux" "FormS"]) elems) + [_ (#Meta [meta (#FormS elems)])] + (let [(#Meta [_ form']) (splice replace? (untemplate replace? subst) (tag$ ["lux" "FormS"]) elems)] + (#Meta [meta form'])) [_ (#Meta [_ (#RecordS fields)])] (wrap-meta (form$ (list (tag$ ["lux" "RecordS"]) @@ -1071,7 +1072,7 @@ (def'' (text:= x y) (-> Text Text Bool) - (_jvm_invokevirtual java.lang.Object equals [java.lang.Object] + (_jvm_invokevirtual "java.lang.Object" "equals" ["java.lang.Object"] x [y])) (def'' (get-rep key env) @@ -1146,9 +1147,9 @@ (-> <type> <type> Bool) (<cmp> x y))] - [i= _jvm_leq Int] - [i> _jvm_lgt Int] - [i< _jvm_llt Int] + [i= _jvm_leq Int] + [i> _jvm_lgt Int] + [i< _jvm_llt Int] [r= _jvm_deq Real] [r> _jvm_dgt Real] [r< _jvm_dlt Real] @@ -1198,7 +1199,7 @@ (def'' (text:++ x y) (-> Text Text Text) - (_jvm_invokevirtual java.lang.String concat [java.lang.String] + (_jvm_invokevirtual "java.lang.String" "concat" ["java.lang.String"] x [y])) (def'' (ident->text ident) @@ -1396,7 +1397,7 @@ (def'' #export (->text x) (-> (^ java.lang.Object) Text) - (_jvm_invokevirtual java.lang.Object toString [] x [])) + (_jvm_invokevirtual "java.lang.Object" "toString" [] x [])) (def'' (interpose sep xs) (All [a] @@ -2039,22 +2040,22 @@ (def (last-index-of part text) (-> Text Text Int) - (_jvm_i2l (_jvm_invokevirtual java.lang.String lastIndexOf [java.lang.String] + (_jvm_i2l (_jvm_invokevirtual "java.lang.String" "lastIndexOf" ["java.lang.String"] text [part]))) (def (index-of part text) (-> Text Text Int) - (_jvm_i2l (_jvm_invokevirtual java.lang.String indexOf [java.lang.String] + (_jvm_i2l (_jvm_invokevirtual "java.lang.String" "indexOf" ["java.lang.String"] text [part]))) (def (substring1 idx text) (-> Int Text Text) - (_jvm_invokevirtual java.lang.String substring [int] + (_jvm_invokevirtual "java.lang.String" "substring" ["int"] text [(_jvm_l2i idx)])) (def (substring2 idx1 idx2 text) (-> Int Int Text Text) - (_jvm_invokevirtual java.lang.String substring [int int] + (_jvm_invokevirtual "java.lang.String" "substring" ["int" "int"] text [(_jvm_l2i idx1) (_jvm_l2i idx2)])) (def (split-module-contexts module) diff --git a/source/lux/data/char.lux b/source/lux/data/char.lux index 5dac9a3c7..5a811c006 100644 --- a/source/lux/data/char.lux +++ b/source/lux/data/char.lux @@ -18,4 +18,4 @@ (defstruct #export Char/Show (S;Show Char) (def (S;show x) - ($ text:++ "#\"" (_jvm_invokevirtual java.lang.Object toString [] x []) "\""))) + ($ text:++ "#\"" (_jvm_invokevirtual "java.lang.Object" "toString" [] x []) "\""))) diff --git a/source/lux/data/io.lux b/source/lux/data/io.lux index 17e8d727a..a194fc854 100644 --- a/source/lux/data/io.lux +++ b/source/lux/data/io.lux @@ -44,8 +44,8 @@ ## Functions (def #export (print x) (-> Text (IO (,))) - (io (_jvm_invokevirtual java.io.PrintStream print [java.lang.Object] - (_jvm_getstatic java.lang.System out) [x]))) + (io (_jvm_invokevirtual "java.io.PrintStream" "print" ["java.lang.Object"] + (_jvm_getstatic "java.lang.System" "out") [x]))) (def #export (println x) (-> Text (IO (,))) diff --git a/source/lux/data/number.lux b/source/lux/data/number.lux index b222de15c..453c30a13 100644 --- a/source/lux/data/number.lux +++ b/source/lux/data/number.lux @@ -62,12 +62,6 @@ (def E;= r=)) ## Ord -## (def #export Int/Ord (O;Ord Int) -## (O;ord$ Int/Eq i< i>)) - -## (def #export Real/Ord (O;Ord Real) -## (O;ord$ Real/Eq r< r>)) - (do-template [<name> <type> <eq> <lt> <gt>] [(defstruct #export <name> (O;Ord <type>) (def O;_eq <eq>) @@ -89,8 +83,8 @@ (def B;top <top>) (def B;bottom <bottom>))] - [ Int/Bounded Int (_jvm_getstatic java.lang.Long MAX_VALUE) (_jvm_getstatic java.lang.Long MIN_VALUE)] - [Real/Bounded Real (_jvm_getstatic java.lang.Double MAX_VALUE) (_jvm_getstatic java.lang.Double MIN_VALUE)]) + [ Int/Bounded Int (_jvm_getstatic "java.lang.Long" "MAX_VALUE") (_jvm_getstatic "java.lang.Long" "MIN_VALUE")] + [Real/Bounded Real (_jvm_getstatic "java.lang.Double" "MAX_VALUE") (_jvm_getstatic "java.lang.Double" "MIN_VALUE")]) ## Monoid (do-template [<name> <type> <unit> <++>] @@ -114,6 +108,6 @@ (def (S;show x) <body>))] - [ Int/Show Int (_jvm_invokevirtual java.lang.Object toString [] x [])] - [Real/Show Real (_jvm_invokevirtual java.lang.Object toString [] x [])] + [ Int/Show Int (_jvm_invokevirtual "java.lang.Object" "toString" [] x [])] + [Real/Show Real (_jvm_invokevirtual "java.lang.Object" "toString" [] x [])] ) diff --git a/source/lux/data/text.lux b/source/lux/data/text.lux index a3192a1d5..f7f1a86c0 100644 --- a/source/lux/data/text.lux +++ b/source/lux/data/text.lux @@ -15,30 +15,30 @@ ## [Functions] (def #export (size x) (-> Text Int) - (_jvm_i2l (_jvm_invokevirtual java.lang.String length [] + (_jvm_i2l (_jvm_invokevirtual "java.lang.String" "length" [] x []))) (def #export (@ idx x) (-> Int Text (Maybe Char)) (if (and (i< idx (size x)) (i>= idx 0)) - (#;Some (_jvm_invokevirtual java.lang.String charAt [int] + (#;Some (_jvm_invokevirtual "java.lang.String" "charAt" ["int"] x [(_jvm_l2i idx)])) #;None)) (def #export (contains? x y) (-> Text Text Bool) - (_jvm_invokevirtual java.lang.String contains [java.lang.CharSequence] + (_jvm_invokevirtual "java.lang.String" "contains" ["java.lang.CharSequence"] x [y])) (do-template [<name> <method>] [(def #export (<name> x) (-> Text Text) - (_jvm_invokevirtual java.lang.String <method> [] + (_jvm_invokevirtual "java.lang.String" <method> [] x []))] - [lower-case toLowerCase] - [upper-case toUpperCase] - [trim trim] + [lower-case "toLowerCase"] + [upper-case "toUpperCase"] + [trim "trim"] ) (def #export (sub' from to x) @@ -46,7 +46,7 @@ (if (and (i< from to) (i>= from 0) (i<= to (size x))) - (_jvm_invokevirtual java.lang.String substring [int int] + (_jvm_invokevirtual "java.lang.String" "substring" ["int" "int"] x [(_jvm_l2i from) (_jvm_l2i to)]) #;None)) @@ -58,23 +58,23 @@ (-> Int Text (Maybe (, Text Text))) (if (and (i< at (size x)) (i>= at 0)) - (let [pre (_jvm_invokevirtual java.lang.String substring [int int] + (let [pre (_jvm_invokevirtual "java.lang.String" "substring" ["int" "int"] x [(_jvm_l2i 0) (_jvm_l2i at)]) - post (_jvm_invokevirtual java.lang.String substring [int] + post (_jvm_invokevirtual "java.lang.String" "substring" ["int"] x [(_jvm_l2i at)])] (#;Some [pre post])) #;None)) (def #export (replace pattern value template) (-> Text Text Text Text) - (_jvm_invokevirtual java.lang.String replace [java.lang.CharSequence java.lang.CharSequence] + (_jvm_invokevirtual "java.lang.String" "replace" ["java.lang.CharSequence" "java.lang.CharSequence"] template [pattern value])) (do-template [<common> <general> <method>] [(def #export (<general> pattern from x) (-> Text Int Text (Maybe Int)) (if (and (i< from (size x)) (i>= from 0)) - (case (_jvm_i2l (_jvm_invokevirtual java.lang.String <method> [java.lang.String int] + (case (_jvm_i2l (_jvm_invokevirtual "java.lang.String" <method> ["java.lang.String" "int"] x [pattern (_jvm_l2i from)])) -1 #;None idx (#;Some idx)) @@ -82,13 +82,13 @@ (def #export (<common> pattern x) (-> Text Text (Maybe Int)) - (case (_jvm_i2l (_jvm_invokevirtual java.lang.String <method> [java.lang.String] + (case (_jvm_i2l (_jvm_invokevirtual "java.lang.String" <method> ["java.lang.String"] x [pattern])) -1 #;None idx (#;Some idx)))] - [index-of index-of' indexOf] - [last-index-of last-index-of' lastIndexOf] + [index-of index-of' "indexOf"] + [last-index-of last-index-of' "lastIndexOf"] ) (def #export (starts-with? prefix x) @@ -113,27 +113,22 @@ ## [Structures] (defstruct #export Text/Eq (E;Eq Text) (def (E;= x y) - (_jvm_invokevirtual java.lang.Object equals [java.lang.Object] + (_jvm_invokevirtual "java.lang.Object" "equals" ["java.lang.Object"] x [y]))) (defstruct #export Text/Ord (O;Ord Text) (def O;_eq Text/Eq) - (def (O;< x y) - (i< (_jvm_i2l (_jvm_invokevirtual java.lang.String compareTo [java.lang.String] - x [y])) - 0)) - (def (O;<= x y) - (i<= (_jvm_i2l (_jvm_invokevirtual java.lang.String compareTo [java.lang.String] - x [y])) - 0)) - (def (O;> x y) - (i> (_jvm_i2l (_jvm_invokevirtual java.lang.String compareTo [java.lang.String] - x [y])) - 0)) - (def (O;>= x y) - (i>= (_jvm_i2l (_jvm_invokevirtual java.lang.String compareTo [java.lang.String] - x [y])) - 0))) + + (do-template [<name> <op>] + [(def (<name> x y) + (<op> (_jvm_i2l (_jvm_invokevirtual "java.lang.String" "compareTo" ["java.lang.String"] + x [y])) + 0))] + + [O;< i<] + [O;<= i<=] + [O;> i>] + [O;>= i>=])) (defstruct #export Text/Show (S;Show Text) (def (S;show x) @@ -142,5 +137,5 @@ (defstruct #export Text/Monoid (m;Monoid Text) (def m;unit "") (def (m;++ x y) - (_jvm_invokevirtual java.lang.String concat [java.lang.String] + (_jvm_invokevirtual "java.lang.String" "concat" ["java.lang.String"] x [y]))) diff --git a/source/lux/host/java.lux b/source/lux/host/jvm.lux index 9bd0c838c..a3a74d608 100644 --- a/source/lux/host/java.lux +++ b/source/lux/host/jvm.lux @@ -16,7 +16,8 @@ macro syntax))) -## [Utils/Parsers] +## [Utils] +## Parsers (def finally^ (Parser Syntax) (form^ (do Parser/Monad @@ -88,20 +89,6 @@ (M;wrap [method arity-classes arity-args]) ))) -## [Utils/Lux] -## (def (find-class-field field class) -## (-> Text Text (Lux Type)) -## ...) - -## (def (find-virtual-method method class) -## (-> Text Text (Lux (List (, (List Type) Type)))) -## ...) - -## (def (find-static-method method class) -## (-> Text Text (Lux (List (, (List Type) Type)))) -## ...) - - ## [Syntax] (defsyntax #export (throw ex) (emit (list (` (_jvm_throw (~ ex)))))) @@ -192,100 +179,73 @@ (emit (list (` (_jvm_program (~ (symbol$ args)) (~ body)))))) -## (defsyntax #export (.? [field local-symbol^] obj) -## (case obj -## (#;Meta [_ (#;SymbolS obj-name)]) -## (do Lux/Monad -## [obj-type (find-var-type obj-name)] -## (case obj-type -## (#;DataT class) -## (do Lux/Monad -## [field-class (find-field field class)] -## (_jvm_getfield (~ (text$ class)) (~ (text$ field)) (~ (text$ field-class)))) - -## _ -## (fail "Can only get field from object."))) - -## _ -## (do Lux/Monad -## [g!obj (gensym "")] -## (emit (list (` (;let [(~ g!obj) (~ obj)] -## (.? (~ field) (~ g!obj))))))))) - -## (defsyntax #export (.= [field local-symbol^] value obj) -## (case obj -## (#;Meta [_ (#;SymbolS obj-name)]) -## (do Lux/Monad -## [obj-type (find-var-type obj-name)] -## (case obj-type -## (#;DataT class) -## (do Lux/Monad -## [field-class (find-field field class)] -## (_jvm_putfield (~ (text$ class)) (~ (text$ field)) (~ (text$ field-class)) (~ value))) - -## _ -## (fail "Can only set field of object."))) - -## _ -## (do Lux/Monad -## [g!obj (gensym "")] -## (emit (list (` (;let [(~ g!obj) (~ obj)] -## (.= (~ field) (~ value) (~ g!obj))))))))) - -## (defsyntax #export (.! [call method-call^] obj) -## (case obj -## (#;Meta [_ (#;SymbolS obj-name)]) -## (do Lux/Monad -## [obj-type (find-var-type obj-name)] -## (case obj-type -## (#;DataT class) -## (do Lux/Monad -## [#let [[m-name ?m-classes m-args] call] -## all-m-details (find-virtual-method m-name class) -## m-ins (case [?m-classes all-m-details] -## (\ [#;None (list [m-ins m-out])]) -## (M;wrap m-ins) - -## (\ [(#;Some m-ins) _]) -## (M;wrap m-ins) - -## _ -## #;None)] -## (emit (list (` (_jvm_invokevirtual (~ (text$ m-name)) (~ (text$ class)) [(~@ (:: List/Functor (F;map text$ m-ins)))] -## (~ obj) [(~@ m-args)]))))) - -## _ -## (fail "Can only call method on object."))) - -## _ -## (do Lux/Monad -## [g!obj (gensym "")] -## (emit (list (` (;let [(~ g!obj) (~ obj)] -## (.! (~@ *tokens*))))))))) - -## (defsyntax #export (..? [field local-symbol^] [class local-symbol^]) -## (emit (list (` (_jvm_getstatic (~ (text$ class)) (~ (text$ field))))))) - -## (defsyntax #export (..= [field local-symbol^] value [class local-symbol^]) -## (emit (list (` (_jvm_putstatic (~ (text$ class)) (~ (text$ field)) (~ value)))))) - -## (defsyntax #export (..! [call method-call^] [class local-symbol^]) -## (do Lux/Monad -## [#let [[m-name ?m-classes m-args] call] -## all-m-details (find-static-method m-name class) -## m-ins (case [?m-classes all-m-details] -## (\ [#;None (list [m-ins m-out])]) -## (M;wrap m-ins) - -## (\ [(#;Some m-ins) _]) -## (M;wrap m-ins) - -## _ -## #;None)] -## (emit (list (` (_jvm_invokestatic (~ (text$ m-name)) (~ (text$ class)) -## [(~@ (:: List/Functor (F;map text$ m-ins)))] -## [(~@ m-args)])))) -## )) +(defsyntax #export (.? [field local-symbol^] obj) + (case obj + (#;Meta [_ (#;SymbolS obj-name)]) + (do Lux/Monad + [obj-type (find-var-type obj-name)] + (case obj-type + (#;DataT class) + (emit (list (` (_jvm_getfield (~ (text$ class)) (~ (text$ field)))))) + + _ + (fail "Can only get field from object."))) + + _ + (do Lux/Monad + [g!obj (gensym "")] + (emit (list (` (;let [(~ g!obj) (~ obj)] + (.? (~ (text$ field)) (~ g!obj))))))))) + +(defsyntax #export (.= [field local-symbol^] value obj) + (case obj + (#;Meta [_ (#;SymbolS obj-name)]) + (do Lux/Monad + [obj-type (find-var-type obj-name)] + (case obj-type + (#;DataT class) + (emit (list (` (_jvm_putfield (~ (text$ class)) (~ (text$ field)) (~ value))))) + + _ + (fail "Can only set field of object."))) + + _ + (do Lux/Monad + [g!obj (gensym "")] + (emit (list (` (;let [(~ g!obj) (~ obj)] + (.= (~ (text$ field)) (~ value) (~ g!obj))))))))) + +(defsyntax #export (.! [call method-call^] obj) + (case obj + (#;Meta [_ (#;SymbolS obj-name)]) + (do Lux/Monad + [obj-type (find-var-type obj-name)] + (case obj-type + (#;DataT class) + (let [[m-name ?m-classes m-args] call] + (emit (list (` (_jvm_invokevirtual (~ (text$ class)) (~ (text$ m-name)) [(~@ (map text$ ?m-classes))] + (~ obj) [(~@ m-args)]))))) + + _ + (fail "Can only call method on object."))) + + _ + (do Lux/Monad + [g!obj (gensym "")] + (emit (list (` (;let [(~ g!obj) (~ obj)] + (.! (~@ *tokens*))))))))) + +(defsyntax #export (..? [field local-symbol^] [class local-symbol^]) + (emit (list (` (_jvm_getstatic (~ (text$ class)) (~ (text$ field))))))) + +(defsyntax #export (..= [field local-symbol^] value [class local-symbol^]) + (emit (list (` (_jvm_putstatic (~ (text$ class)) (~ (text$ field)) (~ value)))))) + +(defsyntax #export (..! [call method-call^] [class local-symbol^]) + (let [[m-name m-classes m-args] call] + (emit (list (` (_jvm_invokestatic (~ (text$ class)) (~ (text$ m-name)) + [(~@ (map text$ m-classes))] + [(~@ m-args)])))))) ## (definterface Function [] ## (#public #abstract apply [java.lang.Object] java.lang.Object)) diff --git a/source/lux/math.lux b/source/lux/math.lux index 2e29c5da7..8a9432261 100644 --- a/source/lux/math.lux +++ b/source/lux/math.lux @@ -12,49 +12,49 @@ (do-template [<name> <value>] [(def #export <name> Real - (_jvm_getstatic java.lang.Math <value>))] + (_jvm_getstatic "java.lang.Math" <value>))] - [e E] - [pi PI] + [e "E"] + [pi "PI"] ) ## [Functions] (do-template [<name> <method>] [(def #export (<name> n) (-> Real Real) - (_jvm_invokestatic java.lang.Math <method> [double] [n]))] + (_jvm_invokestatic "java.lang.Math" <method> ["double"] [n]))] - [cos cos] - [sin sin] - [tan tan] + [cos "cos"] + [sin "sin"] + [tan "tan"] - [acos acos] - [asin asin] - [atan atan] + [acos "acos"] + [asin "asin"] + [atan "atan"] - [cosh cosh] - [sinh sinh] - [tanh tanh] + [cosh "cosh"] + [sinh "sinh"] + [tanh "tanh"] - [ceil ceil] - [floor floor] - [round round] + [ceil "ceil"] + [floor "floor"] + [round "round"] - [exp exp] - [log log] + [exp "exp"] + [log "log"] - [cbrt cbrt] - [sqrt sqrt] + [cbrt "cbrt"] + [sqrt "sqrt"] - [->degrees toDegrees] - [->radians toRadians] + [->degrees "toDegrees"] + [->radians "toRadians"] ) (do-template [<name> <method>] [(def #export (<name> x y) (-> Real Real Real) - (_jvm_invokestatic java.lang.Math <method> [double double] [x y]))] + (_jvm_invokestatic "java.lang.Math" <method> ["double" "double"] [x y]))] - [atan2 atan2] - [pow pow] + [atan2 "atan2"] + [pow "pow"] ) diff --git a/source/lux/meta/syntax.lux b/source/lux/meta/syntax.lux index 83702f75d..fcee80b8f 100644 --- a/source/lux/meta/syntax.lux +++ b/source/lux/meta/syntax.lux @@ -235,7 +235,7 @@ _ (l;fail "Syntax pattern expects 2-tuples or symbols.")))) args) - g!tokens (gensym "tokens") + #let [g!tokens (m;symbol$ ["" "*tokens*"])] g!_ (gensym "_") #let [names (:: List/Functor (F;map first names+parsers)) error-msg (text$ (text:++ "Wrong syntax for " name)) diff --git a/source/program.lux b/source/program.lux index 18a2a76ab..37391eda9 100644 --- a/source/program.lux +++ b/source/program.lux @@ -32,7 +32,7 @@ state (text #as t #open ("text:" Text/Monoid)) writer) - (host java) + (host jvm) (meta lux macro syntax) |