aboutsummaryrefslogtreecommitdiff
path: root/source
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--source/lux.lux4
-rw-r--r--source/lux/control/comonad.lux4
-rw-r--r--source/lux/control/monad.lux2
-rw-r--r--source/lux/data/list.lux2
-rw-r--r--source/lux/data/number.lux4
-rw-r--r--source/lux/data/text.lux4
-rw-r--r--source/lux/host/jvm.lux108
-rw-r--r--source/lux/math.lux5
-rw-r--r--source/lux/meta/lux.lux16
-rw-r--r--source/lux/meta/syntax.lux4
-rw-r--r--source/program.lux10
11 files changed, 67 insertions, 96 deletions
diff --git a/source/lux.lux b/source/lux.lux
index c51929635..8861bc241 100644
--- a/source/lux.lux
+++ b/source/lux.lux
@@ -2524,8 +2524,8 @@
(let [pattern (record$ (map (: (-> (, Text Type) (, Syntax Syntax))
(lambda [slot]
(let [[sname stype] slot
- full-name (split-slot sname)]
- [(tag$ full-name) (symbol$ full-name)])))
+ [module name] (split-slot sname)]
+ [(tag$ [module name]) (symbol$ ["" name])])))
slots))]
(return (list (` (_lux_case (~ struct) (~ pattern) (~ body))))))
diff --git a/source/lux/control/comonad.lux b/source/lux/control/comonad.lux
index 1830ff44f..ce9a7e7de 100644
--- a/source/lux/control/comonad.lux
+++ b/source/lux/control/comonad.lux
@@ -27,8 +27,8 @@
(All [w a b]
(-> (CoMonad w) (-> (w a) b) (w a) (w b)))
(using w
- (using ;;_functor
- (F;map f (;;split ma)))))
+ (using _functor
+ (map f (split ma)))))
## Syntax
(defmacro #export (be tokens state)
diff --git a/source/lux/control/monad.lux b/source/lux/control/monad.lux
index b5552f987..a03c1499a 100644
--- a/source/lux/control/monad.lux
+++ b/source/lux/control/monad.lux
@@ -82,7 +82,7 @@
(All [m a b]
(-> (Monad m) (-> a (m b)) (m a) (m b)))
(using m
- (;;join (:: ;;_functor (F;map f ma)))))
+ (join (:: _functor (F;map f ma)))))
(def #export (map% m f xs)
(All [m a b]
diff --git a/source/lux/data/list.lux b/source/lux/data/list.lux
index 450dee275..8fd5c2951 100644
--- a/source/lux/data/list.lux
+++ b/source/lux/data/list.lux
@@ -247,4 +247,4 @@
(def (M;join mma)
(using List/Monoid
- (foldL m;++ m;unit mma))))
+ (foldL ++ unit mma))))
diff --git a/source/lux/data/number.lux b/source/lux/data/number.lux
index 453c30a13..8771ef06e 100644
--- a/source/lux/data/number.lux
+++ b/source/lux/data/number.lux
@@ -68,11 +68,11 @@
(def O;< <lt>)
(def (O;<= x y)
(or (<lt> x y)
- (using <eq> (E;= x y))))
+ (:: <eq> (E;= x y))))
(def O;> <gt>)
(def (O;>= x y)
(or (<gt> x y)
- (using <eq> (E;= x y)))))]
+ (:: <eq> (E;= x y)))))]
[ Int/Ord Int Int/Eq i< i>]
[Real/Ord Real Real/Eq r< r>])
diff --git a/source/lux/data/text.lux b/source/lux/data/text.lux
index f7f1a86c0..6ad9cfd63 100644
--- a/source/lux/data/text.lux
+++ b/source/lux/data/text.lux
@@ -46,8 +46,8 @@
(if (and (i< from to)
(i>= from 0)
(i<= to (size x)))
- (_jvm_invokevirtual "java.lang.String" "substring" ["int" "int"]
- x [(_jvm_l2i from) (_jvm_l2i to)])
+ (#;Some (_jvm_invokevirtual "java.lang.String" "substring" ["int" "int"]
+ x [(_jvm_l2i from) (_jvm_l2i to)]))
#;None))
(def #export (sub from x)
diff --git a/source/lux/host/jvm.lux b/source/lux/host/jvm.lux
index a3a74d608..7af043969 100644
--- a/source/lux/host/jvm.lux
+++ b/source/lux/host/jvm.lux
@@ -22,8 +22,7 @@
(Parser Syntax)
(form^ (do Parser/Monad
[_ (symbol?^ ["" "finally"])
- expr id^
- _ end^]
+ expr id^]
(M;wrap expr))))
(def catch^
@@ -32,8 +31,7 @@
[_ (symbol?^ ["" "catch"])
ex-class local-symbol^
ex symbol^
- expr id^
- _ end^]
+ expr id^]
(M;wrap [ex-class ex expr]))))
(def method-decl^
@@ -42,8 +40,7 @@
[modifiers (*^ local-tag^)
name local-symbol^
inputs (tuple^ (*^ local-symbol^))
- output local-symbol^
- _ end^]
+ output local-symbol^]
(M;wrap [modifiers name inputs output]))))
(def field-decl^
@@ -51,16 +48,14 @@
(form^ (do Parser/Monad
[modifiers (*^ local-tag^)
name local-symbol^
- class local-symbol^
- _ end^]
+ class local-symbol^]
(M;wrap [modifiers name class]))))
(def arg-decl^
(Parser (, Text Text))
(form^ (do Parser/Monad
[arg-name local-symbol^
- arg-class local-symbol^
- _ end^]
+ arg-class local-symbol^]
(M;wrap [arg-name arg-class]))))
(def method-def^
@@ -70,8 +65,7 @@
name local-symbol^
inputs (tuple^ (*^ arg-decl^))
output local-symbol^
- body id^
- _ end^]
+ body id^]
(M;wrap [modifiers name inputs output body]))))
(def method-call^
@@ -80,7 +74,6 @@
[method local-symbol^
arity-classes (tuple^ (*^ local-symbol^))
arity-args (tuple^ (*^ id^))
- _ end^
_ (: (Parser (,))
(if (i= (size arity-classes)
(size arity-args))
@@ -108,47 +101,41 @@
(list (` (_jvm_finally (~ finally)))))))))))))
(defsyntax #export (definterface [name local-symbol^] [supers (tuple^ (*^ local-symbol^))] [members (*^ method-decl^)])
- (do Lux/Monad
- [current-module get-module-name
- #let [full-name (:: text;Text/Monoid (m;++ (text;replace "/" "." current-module)
- name))]]
- (let [members' (map (: (-> (, (List Text) Text (List Text) Text) Syntax)
- (lambda [member]
- (let [[modifiers name inputs output] member]
- (` ((~ (symbol$ ["" name])) [(~@ (map text$ inputs))] (~ (text$ output)) [(~@ (map text$ modifiers))])))))
- members)]
- (emit (list (` (_jvm_interface (~ (text$ full-name)) [(~@ (map text$ supers))]
- (~@ members'))))))))
+ (let [members' (map (: (-> (, (List Text) Text (List Text) Text) Syntax)
+ (lambda [member]
+ (let [[modifiers name inputs output] member]
+ (` ((~ (text$ name)) [(~@ (map text$ inputs))] (~ (text$ output)) [(~@ (map text$ modifiers))])))))
+ members)]
+ (emit (list (` (_jvm_interface (~ (text$ name)) [(~@ (map text$ supers))]
+ (~@ members')))))))
(defsyntax #export (defclass [name local-symbol^] [super local-symbol^] [interfaces (tuple^ (*^ local-symbol^))]
[fields (*^ field-decl^)]
[methods (*^ method-def^)])
(do Lux/Monad
[current-module get-module-name
- #let [full-name (:: text;Text/Monoid (m;++ (text;replace "/" "." current-module)
- name))
- fields' (map (: (-> (, (List Text) Text Text) Syntax)
+ #let [fields' (map (: (-> (, (List Text) Text Text) Syntax)
(lambda [field]
(let [[modifiers name class] field]
- (` ((~ (symbol$ ["" name]))
+ (` ((~ (text$ name))
(~ (text$ class))
[(~@ (map text$ modifiers))])))))
fields)
methods' (map (: (-> (, (List Text) Text (List (, Text Text)) Text Syntax) Syntax)
(lambda [methods]
(let [[modifiers name inputs output body] methods]
- (` ((~ (symbol$ ["" name]))
+ (` ((~ (text$ name))
[(~@ (map (: (-> (, Text Text) Syntax)
(lambda [in]
(let [[left right] in]
- (form$ (list (text$ left)
+ (form$ (list (symbol$ ["" left])
(text$ right))))))
inputs))]
(~ (text$ output))
[(~@ (map text$ modifiers))]
(~ body))))))
methods)]]
- (emit (list (` (_jvm_class (~ (text$ full-name)) (~ (text$ super))
+ (emit (list (` (_jvm_class (~ (text$ name)) (~ (text$ super))
[(~@ (map text$ interfaces))]
[(~@ fields')]
[(~@ methods')]))))))
@@ -166,9 +153,9 @@
[g!lock (gensym "")
g!body (gensym "")]
(emit (list (` (;let [(~ g!lock) (~ lock)
- _ (_jvm_monitor-enter (~ g!lock))
+ _ (_jvm_monitorenter (~ g!lock))
(~ g!body) (~ body)
- _ (_jvm_monitor-exit (~ g!lock))]
+ _ (_jvm_monitorexit (~ g!lock))]
(~ g!body)))))
))
@@ -216,24 +203,27 @@
(.= (~ (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]
+ (let [[m-name ?m-classes m-args] call]
+ (case obj
+ (#;Meta [_ (#;SymbolS obj-name)])
+ (do Lux/Monad
+ [obj-type (find-var-type obj-name)]
+ (case obj-type
+ (#;DataT class)
(emit (list (` (_jvm_invokevirtual (~ (text$ class)) (~ (text$ m-name)) [(~@ (map text$ ?m-classes))]
- (~ obj) [(~@ m-args)])))))
+ (~ obj) [(~@ m-args)]))))
- _
- (fail "Can only call method on object.")))
+ _
+ (fail "Can only call method on object.")))
- _
- (do Lux/Monad
- [g!obj (gensym "")]
- (emit (list (` (;let [(~ g!obj) (~ obj)]
- (.! (~@ *tokens*)))))))))
+ _
+ (do Lux/Monad
+ [g!obj (gensym "")]
+ (emit (list (` (;let [(~ g!obj) (~ obj)]
+ (.! ((~ (symbol$ ["" m-name]))
+ [(~@ (map (lambda [c] (symbol$ ["" c])) ?m-classes))]
+ [(~@ m-args)])
+ (~ g!obj))))))))))
(defsyntax #export (..? [field local-symbol^] [class local-symbol^])
(emit (list (` (_jvm_getstatic (~ (text$ class)) (~ (text$ field)))))))
@@ -246,25 +236,3 @@
(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))
-
-## (_jvm_interface "Function" []
-## (apply ["java.lang.Object"] "java.lang.Object" ["public" "abstract"]))
-
-## (defclass MyFunction [Function]
-## (#public #static foo java.lang.Object)
-## (#public <init> [] void
-## (_jvm_invokespecial java.lang.Object <init> [] this []))
-## (#public apply [(arg java.lang.Object)] java.lang.Object
-## "YOLO"))
-
-## (_jvm_class "lux.MyFunction" "java.lang.Object" ["lux.Function"]
-## [(foo "java.lang.Object" ["public" "static"])]
-## (<init> [] "void"
-## ["public"]
-## (_jvm_invokespecial java.lang.Object <init> [] this []))
-## (apply [(arg "java.lang.Object")] "java.lang.Object"
-## ["public"]
-## "YOLO"))
diff --git a/source/lux/math.lux b/source/lux/math.lux
index 8a9432261..a495d130c 100644
--- a/source/lux/math.lux
+++ b/source/lux/math.lux
@@ -38,7 +38,6 @@
[ceil "ceil"]
[floor "floor"]
- [round "round"]
[exp "exp"]
[log "log"]
@@ -50,6 +49,10 @@
[->radians "toRadians"]
)
+(def #export (round n)
+ (-> Real Int)
+ (_jvm_invokestatic "java.lang.Math" "round" ["double"] [n]))
+
(do-template [<name> <method>]
[(def #export (<name> x y)
(-> Real Real Real)
diff --git a/source/lux/meta/lux.lux b/source/lux/meta/lux.lux
index 99ca200cf..19b7dd9df 100644
--- a/source/lux/meta/lux.lux
+++ b/source/lux/meta/lux.lux
@@ -187,14 +187,14 @@
(case (get module (get@ #;modules state))
(#;Some =module)
(using List/Monad
- (#;Right [state (M;join (:: M;_functor (F;map (: (-> (, Text (, Bool (DefData' Macro)))
- (List Text))
- (lambda [gdef]
- (let [[name [export? _]] gdef]
- (if export?
- (list name)
- (list)))))
- (get@ #;defs =module))))]))
+ (#;Right [state (join (:: _functor (F;map (: (-> (, Text (, Bool (DefData' Macro)))
+ (List Text))
+ (lambda [gdef]
+ (let [[name [export? _]] gdef]
+ (if export?
+ (list name)
+ (list)))))
+ (get@ #;defs =module))))]))
#;None
(#;Left ($ text:++ "Unknown module: " module))))
diff --git a/source/lux/meta/syntax.lux b/source/lux/meta/syntax.lux
index fcee80b8f..63ab81475 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)
- #let [g!tokens (m;symbol$ ["" "*tokens*"])]
+ g!tokens (gensym "tokens")
g!_ (gensym "_")
#let [names (:: List/Functor (F;map first names+parsers))
error-msg (text$ (text:++ "Wrong syntax for " name))
@@ -249,7 +249,7 @@
(~ g!_)
(l;fail (~ error-msg)))))))
body
- (reverse names+parsers))
+ (: (List (, Syntax Syntax)) (list& [(symbol$ ["" ""]) (` end^)] (reverse names+parsers))))
macro-def (: Syntax
(` (m;defmacro ((~ (symbol$ ["" name])) (~ g!tokens))
(~ body'))))]]
diff --git a/source/program.lux b/source/program.lux
index 37391eda9..086506725 100644
--- a/source/program.lux
+++ b/source/program.lux
@@ -41,8 +41,8 @@
(program args
(case args
- #;Nil
- (println "Hello, world!")
-
- (#;Cons [name _])
- (println ($ text:++ "Hello, " name "!"))))
+ (\ (list name))
+ (println ($ text:++ "Hello, " name "!"))
+
+ _
+ (println "Hello, world!")))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-27 11:24:23 +0000