aboutsummaryrefslogtreecommitdiff
path: root/source/lux
diff options
context:
space:
mode:
Diffstat (limited to 'source/lux')
-rw-r--r--source/lux/data/char.lux2
-rw-r--r--source/lux/data/io.lux4
-rw-r--r--source/lux/data/number.lux14
-rw-r--r--source/lux/data/text.lux61
-rw-r--r--source/lux/host/jvm.lux (renamed from source/lux/host/java.lux)178
-rw-r--r--source/lux/math.lux50
-rw-r--r--source/lux/meta/syntax.lux2
7 files changed, 130 insertions, 181 deletions
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))