aboutsummaryrefslogtreecommitdiff
path: root/source/lux/host/jvm.lux
diff options
context:
space:
mode:
authorEduardo Julian2015-08-30 01:20:08 -0400
committerEduardo Julian2015-08-30 01:20:08 -0400
commit0a0fab3581eedbc13df2af40e3db8bc2d2fd8178 (patch)
treefe1003211db254b36cf9c324ffc98f96e994e782 /source/lux/host/jvm.lux
parent196f56b83ed357169efb75b864f81f26c10641f1 (diff)
- Removed the (now obsolete) `' macro.
- Implemented hygienic macros by adding global symbol resolution inside the ` macro.
Diffstat (limited to '')
-rw-r--r--source/lux/host/jvm.lux109
1 files changed, 55 insertions, 54 deletions
diff --git a/source/lux/host/jvm.lux b/source/lux/host/jvm.lux
index 40021d8fa..d7992509a 100644
--- a/source/lux/host/jvm.lux
+++ b/source/lux/host/jvm.lux
@@ -82,21 +82,21 @@
## [Syntax]
(defsyntax #export (throw ex)
- (emit (list (` (_jvm_throw (~ ex))))))
+ (emit (list (` (;_jvm_throw (~ ex))))))
(defsyntax #export (try body [catches (*^ catch^)] [finally (?^ finally^)])
- (emit (list (` (_jvm_try (~ body)
- (~@ (:: List/Monoid (m;++ (map (: (-> (, Text Ident AST) AST)
- (lambda [catch]
- (let [[class ex body] catch]
- (` (_jvm_catch (~ (text$ class)) (~ (symbol$ ex)) (~ body))))))
- catches)
- (case finally
- #;None
- (list)
-
- (#;Some finally)
- (: (List AST) (list (` (_jvm_finally (~ finally))))))))))))))
+ (emit (list (` (;_jvm_try (~ body)
+ (~@ (:: List/Monoid (m;++ (map (: (-> (, Text Ident AST) AST)
+ (lambda [catch]
+ (let [[class ex body] catch]
+ (` (;_jvm_catch (~ (text$ class)) (~ (symbol$ ex)) (~ body))))))
+ catches)
+ (case finally
+ #;None
+ (list)
+
+ (#;Some finally)
+ (: (List AST) (list (` (;_jvm_finally (~ finally))))))))))))))
(defsyntax #export (definterface [name local-symbol^] [supers (tuple^ (*^ local-symbol^))] [members (*^ method-decl^)])
(let [members' (map (: (-> (, (List Text) Text (List Text) Text) AST)
@@ -104,8 +104,8 @@
(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')))))))
+ (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^)]
@@ -133,36 +133,37 @@
[(~@ (map text$ modifiers))]
(~ body))))))
methods)]]
- (emit (list (` (_jvm_class (~ (text$ name)) (~ (text$ super))
- [(~@ (map text$ interfaces))]
- [(~@ fields')]
- [(~@ methods')]))))))
+ (emit (list (` (;_jvm_class (~ (text$ name)) (~ (text$ super))
+ [(~@ (map text$ interfaces))]
+ [(~@ fields')]
+ [(~@ methods')]))))))
(defsyntax #export (new [class local-symbol^] [arg-classes (tuple^ (*^ local-symbol^))] [args (tuple^ (*^ id^))])
- (emit (list (` (_jvm_new (~ (text$ class))
- [(~@ (map text$ arg-classes))]
- [(~@ args)])))))
+ (emit (list (` (;_jvm_new (~ (text$ class))
+ [(~@ (map text$ arg-classes))]
+ [(~@ args)])))))
(defsyntax #export (instance? [class local-symbol^] obj)
- (emit (list (` (_jvm_instanceof (~ (text$ class)) (~ obj))))))
+ (emit (list (` (;_jvm_instanceof (~ (text$ class)) (~ obj))))))
(defsyntax #export (locking lock body)
(do Lux/Monad
[g!lock (gensym "")
- g!body (gensym "")]
- (emit (list (` (;let [(~ g!lock) (~ lock)
- _ (_jvm_monitorenter (~ g!lock))
- (~ g!body) (~ body)
- _ (_jvm_monitorexit (~ g!lock))]
- (~ g!body)))))
+ g!body (gensym "")
+ g!_ (gensym "")]
+ (emit (list (` (let [(~ g!lock) (~ lock)
+ (~ g!_) (;_jvm_monitorenter (~ g!lock))
+ (~ g!body) (~ body)
+ (~ g!_) (;_jvm_monitorexit (~ g!lock))]
+ (~ g!body)))))
))
(defsyntax #export (null? obj)
- (emit (list (` (_jvm_null? (~ obj))))))
+ (emit (list (` (;_jvm_null? (~ obj))))))
(defsyntax #export (program [args symbol^] body)
- (emit (list (` (_jvm_program (~ (symbol$ args))
- (~ body))))))
+ (emit (list (` (;_jvm_program (~ (symbol$ args))
+ (~ body))))))
(defsyntax #export (.? [field local-symbol^] obj)
(case obj
@@ -171,7 +172,7 @@
[obj-type (find-var-type obj-name)]
(case obj-type
(#;DataT class)
- (emit (list (` (_jvm_getfield (~ (text$ class)) (~ (text$ field))))))
+ (emit (list (` (;_jvm_getfield (~ (text$ class)) (~ (text$ field))))))
_
(fail "Can only get field from object.")))
@@ -179,8 +180,8 @@
_
(do Lux/Monad
[g!obj (gensym "")]
- (emit (list (` (;let [(~ g!obj) (~ obj)]
- (.? (~ (text$ field)) (~ g!obj)))))))))
+ (emit (list (` (let [(~ g!obj) (~ obj)]
+ (;;.? (~ (text$ field)) (~ g!obj)))))))))
(defsyntax #export (.= [field local-symbol^] value obj)
(case obj
@@ -189,7 +190,7 @@
[obj-type (find-var-type obj-name)]
(case obj-type
(#;DataT class)
- (emit (list (` (_jvm_putfield (~ (text$ class)) (~ (text$ field)) (~ value)))))
+ (emit (list (` (;_jvm_putfield (~ (text$ class)) (~ (text$ field)) (~ value)))))
_
(fail "Can only set field of object.")))
@@ -197,8 +198,8 @@
_
(do Lux/Monad
[g!obj (gensym "")]
- (emit (list (` (;let [(~ g!obj) (~ obj)]
- (.= (~ (text$ field)) (~ value) (~ g!obj)))))))))
+ (emit (list (` (let [(~ g!obj) (~ obj)]
+ (;;.= (~ (text$ field)) (~ value) (~ g!obj)))))))))
(defsyntax #export (.! [call method-call^] obj)
(let [[m-name ?m-classes m-args] call]
@@ -208,8 +209,8 @@
[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)]))))
+ (emit (list (` (;_jvm_invokevirtual (~ (text$ class)) (~ (text$ m-name)) [(~@ (map text$ ?m-classes))]
+ (~ obj) [(~@ m-args)]))))
_
(fail "Can only call method on object.")))
@@ -217,31 +218,31 @@
_
(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))))))))))
+ (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)))))))
+ (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))))))
+ (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)]))))))
+ (emit (list (` (;_jvm_invokestatic (~ (text$ class)) (~ (text$ m-name))
+ [(~@ (map text$ m-classes))]
+ [(~@ m-args)]))))))
(defsyntax #export (->maybe expr)
(do Lux/Monad
[g!val (gensym "")]
- (emit (list (` (;let [(~ g!val) (~ expr)]
- (;if (null? (~ g!val))
- #;None
- (#;Some (~ g!val)))))))))
+ (emit (list (` (let [(~ g!val) (~ expr)]
+ (if (null? (~ g!val))
+ #;None
+ (#;Some (~ g!val)))))))))
(defsyntax #export (try$ expr)
(emit (list (` (try (#;Right (~ expr))