aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--source/lux.lux213
-rw-r--r--src/lux/analyser.clj15
-rw-r--r--src/lux/analyser/env.clj9
-rw-r--r--src/lux/analyser/host.clj44
-rw-r--r--src/lux/analyser/lambda.clj200
-rw-r--r--src/lux/analyser/lux.clj28
-rw-r--r--src/lux/compiler.clj7
-rw-r--r--src/lux/compiler/host.clj1
-rw-r--r--src/lux/compiler/lambda.clj2
-rw-r--r--src/lux/compiler/lux.clj25
-rw-r--r--src/lux/host.clj44
-rw-r--r--src/lux/macro.clj7
12 files changed, 364 insertions, 231 deletions
diff --git a/source/lux.lux b/source/lux.lux
index 2882207d6..db827760d 100644
--- a/source/lux.lux
+++ b/source/lux.lux
@@ -86,127 +86,98 @@
[(#Cons [output #Nil]) state])))
(declare-macro def)
-## (def' def
-## (lambda (_ tokens state)
-## (let' output (case' tokens
-## (#Cons (#Ident name) (#Cons body #Nil))
-## (#Form (#Cons (#Ident "def'") tokens))
-
-## (#Cons (#Form (#Cons (#Ident name) args))
-## (#Cons body #Nil))
-## (#Form (#Cons (#Ident "def'")
-## (#Cons (#Ident name)
-## (#Cons (#Form (#Cons (#Ident "lux;lambda")
-## (#Cons (#Form (#Cons (#Ident name) args))
-## (#Cons body #Nil))))
-## #Nil)))))
-## [(#Cons output #Nil) state])))
-## (declare-macro def)
-
-## (def (comment tokens state)
-## [#Nil state])
-## (declare-macro comment)
-
-## (def (+ x y)
-## (jvm;iadd x y))
-
-## (def (id x)
-## x)
-
-## (def (print x)
-## (jvm;invokevirtual java.io.PrintStream "print" [Object]
-## (jvm;getstatic System out) [x]))
-
-## (def (println x)
-## (jvm;invokevirtual java.io.PrintStream "println" [Object]
-## (jvm;getstatic System out) [x]))
-
-## (def (fold f init xs)
-## (do (print "fold ") (print init) (print " ") (println xs)
-## (case' xs
-## #Nil
-## init
-
-## (#Cons x xs')
-## (let' init' (f init x)
-## (do (print "init': ") (println init')
-## (fold f init' xs')))
-## #((fold f (f init x) xs'))#
-## )))
-
-## (def (reverse list)
-## (do (print "reverse ") (println list)
-## (let' reversed (fold (lambda [tail head]
-## (do (print "reverse/0 ") (print "tail: ") (print tail) (print " head: ") (println head)
-## (#Cons head tail)))
-## #Nil
-## list)
-## (do (print "!reversed ") (println reversed)
-## reversed))))
-
-## (def (list xs state)
-## (let' xs' (reverse xs)
-## (let' output (fold (lambda [tail head]
-## (do (print "tail: ") (print tail) (print " head: ") (println head)
-## (#Form (#Cons (#Tag "Cons")
-## (#Cons head
-## (#Cons tail #Nil))))))
-## (#Tag "Nil")
-## (do (print "REVERSED: ") (println xs')
-## xs'))
-## (do (print "output: ") (println output)
-## [(#Cons output #Nil) state]))))
-## (declare-macro list)
-
-## (def (list+ xs state)
-## (case' (reverse xs)
-## #Nil
-## [#Nil state]
-
-## (#Cons last init')
-## (let' output (fold (lambda [tail head]
-## (#Form (#Cons (#Tag "Cons")
-## (#Cons head tail))))
-## last
-## init')
-## [(#Cons output #Nil) state])))
-## (declare-macro list+)
-
-## (def (->pairs xs)
-## (case' xs
-## (#Cons x (#Cons y xs'))
-## (#Cons [x y] (->pairs xs'))
-
-## _
-## #Nil))
-
-## (def (let tokens state)
-## (case' tokens
-## (#Cons (#Tuple bindings) (#Cons body #Nil))
-## (let' output (fold (lambda [body binding]
-## (case binding
-## [label value]
-## (#Form (list (#Ident "let'") label value body))))
-## body
-## (reverse (->pairs bindings)))
-## [(list output) state])))
-## (declare-macro let)
-
-## (def (++-list xs ys)
-## (case' xs
-## #Nil
-## ys
-
-## (#Cons x xs*)
-## (#Cons x (++-list xs* ys))))
-
-## (def (map-list f xs)
-## (case' xs
-## #Nil
-## #Nil
-
-## (#Cons x xs*)
-## (#Cons (f x) (map-list f xs*))))
+(def (comment tokens state)
+ [#Nil state])
+(declare-macro comment)
+
+(def (+ x y)
+ (jvm;iadd x y))
+
+(def (id x)
+ x)
+
+(def (print x)
+ (jvm;invokevirtual java.io.PrintStream "print" [java.lang.Object]
+ (jvm;getstatic java.lang.System "out") [x]))
+
+(def (println x)
+ (jvm;invokevirtual java.io.PrintStream "println" [java.lang.Object]
+ (jvm;getstatic java.lang.System "out") [x]))
+
+(def (fold f init xs)
+ (case' xs
+ #Nil
+ init
+
+ (#Cons [x xs'])
+ (fold f (f init x) xs')))
+
+(def (reverse list)
+ (fold (lambda (_ tail head) (#Cons [head tail]))
+ #Nil
+ list))
+
+(def (list xs state)
+ (let' xs' (reverse xs)
+ (let' output (fold (lambda (_ tail head)
+ (#Form (#Cons [(#Tag "Cons")
+ (#Cons [(#Tuple (#Cons [head
+ (#Cons [(#Form (#Cons [(#Tag "Cons")
+ (#Cons [(#Tuple (#Cons [tail
+ (#Cons [(#Tag "Nil") #Nil])])) #Nil])])) #Nil])])) #Nil])])))
+ (#Tag "Nil")
+ xs')
+ [(#Cons [output #Nil]) state])))
+(declare-macro list)
+
+(def (list+ xs state)
+ (case' (reverse xs)
+ #Nil
+ [#Nil state]
+
+ (#Cons [last init'])
+ (let' output (fold (lambda (_ tail head)
+ (#Form (#Cons [(#Tag "Cons") (#Cons [(#Tuple (#Cons [head (#Cons [tail #Nil])])) #Nil])])))
+ last
+ init')
+ [(#Cons [output #Nil]) state])))
+(declare-macro list+)
+
+(def (as-pairs xs)
+ (case' xs
+ (#Cons [x (#Cons [y xs'])])
+ (#Cons [[x y] (as-pairs xs')])
+
+ _
+ #Nil))
+
+(def (let tokens state)
+ (case' tokens
+ (#Cons [(#Tuple bindings) (#Cons [body #Nil])])
+ (let' output (fold (lambda (_ body binding)
+ (case' binding
+ [label value]
+ (#Form (list (#Ident "let'") label value body))))
+ body
+ (reverse (as-pairs bindings)))
+ [(list output) state])))
+(declare-macro let)
+
+(def (++-list xs ys)
+ (case' xs
+ #Nil
+ ys
+
+ (#Cons [x xs*])
+ (#Cons [x (++-list xs* ys)])))
+
+(def (map-list f xs)
+ (case' xs
+ #Nil
+ #Nil
+
+ (#Cons [x xs*])
+ (#Cons [(f x) (map-list f xs*)])))
#(
(def (untemplate-list untemplate tokens)
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index 115d21d6f..faa41913f 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -127,10 +127,10 @@
(&&host/analyse-jvm-drem analyse-ast ?x ?y)
;; Fields & methods
- [::&parser/Form ([[::&parser/Ident "jvm;getstatic"] [::&parser/Ident ?class] [::&parser/Ident ?field]] :seq)]
+ [::&parser/Form ([[::&parser/Ident "jvm;getstatic"] [::&parser/Ident ?class] [::&parser/Text ?field]] :seq)]
(&&host/analyse-jvm-getstatic analyse-ast ?class ?field)
- [::&parser/Form ([[::&parser/Ident "jvm;getfield"] [::&parser/Ident ?class] [::&parser/Ident ?field] ?object] :seq)]
+ [::&parser/Form ([[::&parser/Ident "jvm;getfield"] [::&parser/Ident ?class] [::&parser/Text ?field] ?object] :seq)]
(&&host/analyse-jvm-getfield analyse-ast ?class ?field ?object)
[::&parser/Form ([[::&parser/Ident "jvm;invokestatic"] [::&parser/Ident ?class] [::&parser/Text ?method] [::&parser/Tuple ?classes] [::&parser/Tuple ?args]] :seq)]
@@ -167,7 +167,7 @@
(match token
[::&parser/Form ([[::&parser/Tag ?tag] & ?values] :seq)]
(exec [:let [_ (prn 'PRE-ASSERT)]
- :let [_ (assert (= 1 (count ?values)) "[Analyser Error] Can only tag 1 value.")]
+ :let [_ (assert (= 1 (count ?values)) (str "[Analyser Error] Can only tag 1 value: " (pr-str token)))]
:let [_ (prn 'POST-ASSERT)]
:let [?value (first ?values)]
=value (&&/analyse-1 analyse-ast ?value)
@@ -175,9 +175,14 @@
(return (list [::&&/Expression [::&&/variant ?tag =value] [::&type/Variant (list [?tag =value-type])]])))
[::&parser/Form ([?fn & ?args] :seq)]
- (try-all-m [(&&lux/analyse-call analyse-ast ?fn ?args)
- (analyse-basic-ast analyse-ast token)])
+ (fn [state]
+ (match ((&&/analyse-1 analyse-ast ?fn) state)
+ [::&/ok [state* =fn]]
+ ((&&lux/analyse-call analyse-ast =fn ?args) state*)
+ _
+ ((analyse-basic-ast analyse-ast token) state)))
+
_
(analyse-basic-ast analyse-ast token)))
diff --git a/src/lux/analyser/env.clj b/src/lux/analyser/env.clj
index c68641f7e..55205e597 100644
--- a/src/lux/analyser/env.clj
+++ b/src/lux/analyser/env.clj
@@ -15,10 +15,13 @@
(let [old-mappings (-> state ::&/local-envs first (get-in [:locals :mappings]))
=return (body (update-in state [::&/local-envs]
(fn [[top & stack]]
- (prn 'env/with-local name mode (get-in top [:locals :counter]))
+ ;; (prn 'env/with-local name mode (get-in top [:locals :counter]))
(let [bound-unit (case mode
- :self [::&&/self (list)]
- :local [::&&/local (get-in top [:locals :counter])])]
+ :local [::&&/local (get-in top [:locals :counter])]
+
+ ;; else
+ [::&&/self (second mode) (list)]
+ )]
(cons (-> top
(update-in [:locals :counter] inc)
(assoc-in [:locals :mappings name] [::&&/Expression bound-unit type]))
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index fd4444671..ddc91d2b9 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -16,18 +16,19 @@
(return ?ident)
_
- (fail "")))
+ (fail "[Analyser Error] Can't extract Ident.")))
;; [Resources]
(do-template [<name> <ident> <output-tag> <wrapper-class>]
- (defn <name> [analyse ?x ?y]
- (exec [:let [=type [::&type/Data <wrapper-class>]]
- [=x =y] (&&/analyse-2 analyse ?x ?y)
- =x-type (&&/expr-type =x)
- =y-type (&&/expr-type =y)
- _ (&type/solve =type =x-type)
- _ (&type/solve =type =y-type)]
- (return (list [::&&/Expression [<output-tag> =x =y] =type]))))
+ (let [elem-type [::&type/Data <wrapper-class>]]
+ (defn <name> [analyse ?x ?y]
+ (exec [[=x =y] (&&/analyse-2 analyse ?x ?y)
+ ;; =x-type (&&/expr-type =x)
+ ;; =y-type (&&/expr-type =y)
+ ;; _ (&type/solve elem-type =x-type)
+ ;; _ (&type/solve elem-type =y-type)
+ ]
+ (return (list [::&&/Expression [<output-tag> =x =y] elem-type])))))
analyse-jvm-iadd "jvm;iadd" ::&&/jvm-iadd "java.lang.Integer"
analyse-jvm-isub "jvm;isub" ::&&/jvm-isub "java.lang.Integer"
@@ -56,13 +57,15 @@
(defn analyse-jvm-getstatic [analyse ?class ?field]
(exec [=class (&host/full-class-name ?class)
- =type (&host/lookup-static-field =class ?field)]
+ :let [_ (prn 'analyse-jvm-getstatic/=class =class)]
+ =type (&host/lookup-static-field =class ?field)
+ :let [_ (prn 'analyse-jvm-getstatic/=type =type)]]
(return (list [::&&/Expression [::&&/jvm-getstatic =class ?field] =type]))))
(defn analyse-jvm-getfield [analyse ?class ?field ?object]
(exec [=class (&host/full-class-name ?class)
=type (&host/lookup-static-field =class ?field)
- =object (&&/analyse-1 ?object)]
+ =object (&&/analyse-1 analyse ?object)]
(return (list [::&&/Expression [::&&/jvm-getfield =class ?field =object] =type]))))
(defn analyse-jvm-invokestatic [analyse ?class ?method ?classes ?args]
@@ -74,10 +77,15 @@
(defn analyse-jvm-invokevirtual [analyse ?class ?method ?classes ?object ?args]
(exec [=class (&host/full-class-name ?class)
+ :let [_ (prn 'analyse-jvm-invokevirtual/=class =class)]
=classes (map-m &host/extract-jvm-param ?classes)
- =return (&host/lookup-virtual-method =class ?method =classes)
- =object (&&/analyse-1 ?object)
- =args (mapcat-m analyse ?args)]
+ :let [_ (prn 'analyse-jvm-invokevirtual/=classes =classes)]
+ [=method-args =return] (&host/lookup-virtual-method =class ?method =classes)
+ :let [_ (prn 'analyse-jvm-invokevirtual/=return =return)]
+ =object (&&/analyse-1 analyse ?object)
+ :let [_ (prn 'analyse-jvm-invokevirtual/=object =object)]
+ =args (mapcat-m analyse ?args)
+ :let [_ (prn 'analyse-jvm-invokevirtual/=args =args)]]
(return (list [::&&/Expression [::&&/jvm-invokevirtual =class ?method =classes =object =args] =return]))))
(defn analyse-jvm-new [analyse ?class ?classes ?args]
@@ -91,12 +99,12 @@
(return (list [::&&/Expression [::&&/jvm-new-array =class ?length] [::&type/Array [::&type/Data =class]]]))))
(defn analyse-jvm-aastore [analyse ?array ?idx ?elem]
- (exec [[=array =elem] (&&/analyse-2 ?array ?elem)
+ (exec [[=array =elem] (&&/analyse-2 analyse ?array ?elem)
=array-type (&&/expr-type =array)]
(return (list [::&&/Expression [::&&/jvm-aastore =array ?idx =elem] =array-type]))))
(defn analyse-jvm-aaload [analyse ?array ?idx]
- (exec [=array (&&/analyse-1 ?array)
+ (exec [=array (&&/analyse-1 analyse ?array)
=array-type (&&/expr-type =array)]
(return (list [::&&/Expression [::&&/jvm-aaload =array ?idx] =array-type]))))
@@ -107,7 +115,7 @@
(return [?class ?field-name])
_
- (fail "")))
+ (fail "[Analyser Error] Fields must be Tuple2 of [Ident, Ident]")))
?fields)
:let [=fields (into {} (for [[class field] ?fields]
[field {:access :public
@@ -126,7 +134,7 @@
(return [?member-name [?inputs ?output]]))
_
- (fail "")))
+ (fail "[Analyser Error] Invalid method signature!")))
?members)
:let [=methods (into {} (for [[method [inputs output]] ?members]
[method {:access :public
diff --git a/src/lux/analyser/lambda.clj b/src/lux/analyser/lambda.clj
index b20eb8e19..c0af66050 100644
--- a/src/lux/analyser/lambda.clj
+++ b/src/lux/analyser/lambda.clj
@@ -10,7 +10,7 @@
(defn with-lambda [self self-type arg arg-type body]
(&/with-closure
(exec [scope-name &/get-scope-name]
- (&env/with-local self :self self-type
+ (&env/with-local self [:self scope-name] self-type
(&env/with-local arg :local arg-type
(exec [=return body
=captured &env/captured-vars]
@@ -24,7 +24,7 @@
(update-in [:counter] inc)
(assoc-in [:mappings ident] register*)))])))
-(defn raise-expr [arg syntax]
+(defn raise-expr [out-scope arg syntax]
(match syntax
[::&&/Expression ?form ?type]
(match ?form
@@ -44,10 +44,10 @@
syntax
[::&&/tuple ?members]
- [::&&/Expression [::&&/tuple (map (partial raise-expr arg) ?members)] ?type]
+ [::&&/Expression [::&&/tuple (map (partial raise-expr out-scope arg) ?members)] ?type]
[::&&/variant ?tag ?value]
- [::&&/Expression [::&&/variant ?tag (raise-expr arg ?value)] ?type]
+ [::&&/Expression [::&&/variant ?tag (raise-expr out-scope arg ?value)] ?type]
[::&&/local ?idx]
[::&&/Expression [::&&/local (inc ?idx)] ?type]
@@ -55,102 +55,234 @@
[::&&/captured _ _ ?source]
?source
- [::&&/self ?curried]
- [::&&/Expression [::&&/self (cons arg (map (partial raise-expr arg) ?curried))] ?type]
+ [::&&/self ?scope ?curried]
+ [::&&/Expression [::&&/self out-scope (cons arg (map (partial raise-expr out-scope arg) ?curried))] ?type]
[::&&/global _ _]
syntax
[::&&/case ?variant ?base ?num-bindings ?branches]
- [::&&/Expression [::&&/case (raise-expr arg ?variant) (inc ?base) ?num-bindings
+ [::&&/Expression [::&&/case (raise-expr out-scope arg ?variant) (inc ?base) ?num-bindings
(for [[?pattern ?body] ?branches]
- [?pattern (raise-expr arg ?body)])]
+ [?pattern (raise-expr out-scope arg ?body)])]
?type]
[::&&/lambda ?scope ?captured ?args ?value]
- [::&&/Expression [::&&/lambda (pop ?scope)
+ [::&&/Expression [::&&/lambda (rest ?scope)
(into {} (for [[?name ?sub-syntax] ?captured]
- [?name (raise-expr arg ?sub-syntax)]))
+ [?name (raise-expr out-scope arg ?sub-syntax)]))
?args
?value]
?type]
[::&&/call ?func ?args]
- [::&&/Expression [::&&/call (raise-expr arg ?func) (map (partial raise-expr arg) ?args)] ?type]
+ [::&&/Expression [::&&/call (raise-expr out-scope arg ?func) (map (partial raise-expr out-scope arg) ?args)] ?type]
[::&&/exec ?asts]
- [::&&/Expression [::&&/exec (map (partial raise-expr arg) ?asts)] ?type]
+ [::&&/Expression [::&&/exec (map (partial raise-expr out-scope arg) ?asts)] ?type]
[::&&/jvm-getstatic _ _]
syntax
[::&&/jvm-invokevirtual ?class ?method ?arg-classes ?obj ?args]
[::&&/Expression [::&&/jvm-invokevirtual ?class ?method ?arg-classes
- (raise-expr arg ?obj)
- (map (partial raise-expr arg) ?args)]
+ (raise-expr out-scope arg ?obj)
+ (map (partial raise-expr out-scope arg) ?args)]
?type]
;; Integer arithmetic
[::&&/jvm-iadd ?x ?y]
- [::&&/Expression [::&&/jvm-iadd (raise-expr arg ?x) (raise-expr arg ?y)] ?type]
+ [::&&/Expression [::&&/jvm-iadd (raise-expr out-scope arg ?x) (raise-expr out-scope arg ?y)] ?type]
[::&&/jvm-isub ?x ?y]
- [::&&/Expression [::&&/jvm-isub (raise-expr arg ?x) (raise-expr arg ?y)] ?type]
+ [::&&/Expression [::&&/jvm-isub (raise-expr out-scope arg ?x) (raise-expr out-scope arg ?y)] ?type]
[::&&/jvm-imul ?x ?y]
- [::&&/Expression [::&&/jvm-imul (raise-expr arg ?x) (raise-expr arg ?y)] ?type]
+ [::&&/Expression [::&&/jvm-imul (raise-expr out-scope arg ?x) (raise-expr out-scope arg ?y)] ?type]
[::&&/jvm-idiv ?x ?y]
- [::&&/Expression [::&&/jvm-idiv (raise-expr arg ?x) (raise-expr arg ?y)] ?type]
+ [::&&/Expression [::&&/jvm-idiv (raise-expr out-scope arg ?x) (raise-expr out-scope arg ?y)] ?type]
[::&&/jvm-irem ?x ?y]
- [::&&/Expression [::&&/jvm-irem (raise-expr arg ?x) (raise-expr arg ?y)] ?type]
+ [::&&/Expression [::&&/jvm-irem (raise-expr out-scope arg ?x) (raise-expr out-scope arg ?y)] ?type]
;; Long arithmetic
[::&&/jvm-ladd ?x ?y]
- [::&&/Expression [::&&/jvm-ladd (raise-expr arg ?x) (raise-expr arg ?y)] ?type]
+ [::&&/Expression [::&&/jvm-ladd (raise-expr out-scope arg ?x) (raise-expr out-scope arg ?y)] ?type]
[::&&/jvm-lsub ?x ?y]
- [::&&/Expression [::&&/jvm-lsub (raise-expr arg ?x) (raise-expr arg ?y)] ?type]
+ [::&&/Expression [::&&/jvm-lsub (raise-expr out-scope arg ?x) (raise-expr out-scope arg ?y)] ?type]
[::&&/jvm-lmul ?x ?y]
- [::&&/Expression [::&&/jvm-lmul (raise-expr arg ?x) (raise-expr arg ?y)] ?type]
+ [::&&/Expression [::&&/jvm-lmul (raise-expr out-scope arg ?x) (raise-expr out-scope arg ?y)] ?type]
[::&&/jvm-ldiv ?x ?y]
- [::&&/Expression [::&&/jvm-ldiv (raise-expr arg ?x) (raise-expr arg ?y)] ?type]
+ [::&&/Expression [::&&/jvm-ldiv (raise-expr out-scope arg ?x) (raise-expr out-scope arg ?y)] ?type]
[::&&/jvm-lrem ?x ?y]
- [::&&/Expression [::&&/jvm-lrem (raise-expr arg ?x) (raise-expr arg ?y)] ?type]
+ [::&&/Expression [::&&/jvm-lrem (raise-expr out-scope arg ?x) (raise-expr out-scope arg ?y)] ?type]
;; Float arithmetic
[::&&/jvm-fadd ?x ?y]
- [::&&/Expression [::&&/jvm-fadd (raise-expr arg ?x) (raise-expr arg ?y)] ?type]
+ [::&&/Expression [::&&/jvm-fadd (raise-expr out-scope arg ?x) (raise-expr out-scope arg ?y)] ?type]
[::&&/jvm-fsub ?x ?y]
- [::&&/Expression [::&&/jvm-fsub (raise-expr arg ?x) (raise-expr arg ?y)] ?type]
+ [::&&/Expression [::&&/jvm-fsub (raise-expr out-scope arg ?x) (raise-expr out-scope arg ?y)] ?type]
[::&&/jvm-fmul ?x ?y]
- [::&&/Expression [::&&/jvm-fmul (raise-expr arg ?x) (raise-expr arg ?y)] ?type]
+ [::&&/Expression [::&&/jvm-fmul (raise-expr out-scope arg ?x) (raise-expr out-scope arg ?y)] ?type]
[::&&/jvm-fdiv ?x ?y]
- [::&&/Expression [::&&/jvm-fdiv (raise-expr arg ?x) (raise-expr arg ?y)] ?type]
+ [::&&/Expression [::&&/jvm-fdiv (raise-expr out-scope arg ?x) (raise-expr out-scope arg ?y)] ?type]
[::&&/jvm-frem ?x ?y]
- [::&&/Expression [::&&/jvm-frem (raise-expr arg ?x) (raise-expr arg ?y)] ?type]
+ [::&&/Expression [::&&/jvm-frem (raise-expr out-scope arg ?x) (raise-expr out-scope arg ?y)] ?type]
;; Double arithmetic
[::&&/jvm-dadd ?x ?y]
- [::&&/Expression [::&&/jvm-dadd (raise-expr arg ?x) (raise-expr arg ?y)] ?type]
+ [::&&/Expression [::&&/jvm-dadd (raise-expr out-scope arg ?x) (raise-expr out-scope arg ?y)] ?type]
[::&&/jvm-dsub ?x ?y]
- [::&&/Expression [::&&/jvm-dsub (raise-expr arg ?x) (raise-expr arg ?y)] ?type]
+ [::&&/Expression [::&&/jvm-dsub (raise-expr out-scope arg ?x) (raise-expr out-scope arg ?y)] ?type]
[::&&/jvm-dmul ?x ?y]
- [::&&/Expression [::&&/jvm-dmul (raise-expr arg ?x) (raise-expr arg ?y)] ?type]
+ [::&&/Expression [::&&/jvm-dmul (raise-expr out-scope arg ?x) (raise-expr out-scope arg ?y)] ?type]
[::&&/jvm-ddiv ?x ?y]
- [::&&/Expression [::&&/jvm-ddiv (raise-expr arg ?x) (raise-expr arg ?y)] ?type]
+ [::&&/Expression [::&&/jvm-ddiv (raise-expr out-scope arg ?x) (raise-expr out-scope arg ?y)] ?type]
[::&&/jvm-drem ?x ?y]
- [::&&/Expression [::&&/jvm-drem (raise-expr arg ?x) (raise-expr arg ?y)] ?type]
+ [::&&/Expression [::&&/jvm-drem (raise-expr out-scope arg ?x) (raise-expr out-scope arg ?y)] ?type]
)))
+
+(defn re-scope [out-scope syntax]
+ (let [partial-f (partial re-scope out-scope)]
+ (match syntax
+ [::&&/Expression ?form ?type]
+ (match ?form
+ [::&&/bool ?value]
+ syntax
+
+ [::&&/int ?value]
+ syntax
+
+ [::&&/real ?value]
+ syntax
+
+ [::&&/char ?value]
+ syntax
+
+ [::&&/text ?value]
+ syntax
+
+ [::&&/tuple ?members]
+ [::&&/Expression [::&&/tuple (map partial-f ?members)] ?type]
+
+ [::&&/variant ?tag ?value]
+ [::&&/Expression [::&&/variant ?tag (partial-f ?value)] ?type]
+
+ [::&&/local ?idx]
+ [::&&/Expression [::&&/local ?idx] ?type]
+
+ [::&&/captured _ _ ?source]
+ ?source
+
+ [::&&/self ?scope ?curried]
+ [::&&/Expression [::&&/self out-scope (map partial-f ?curried)] ?type]
+
+ [::&&/global _ _]
+ syntax
+
+ [::&&/case ?variant ?base ?num-bindings ?branches]
+ [::&&/Expression [::&&/case (partial-f ?variant) ?base ?num-bindings
+ (for [[?pattern ?body] ?branches]
+ [?pattern (partial-f ?body)])]
+ ?type]
+
+ [::&&/lambda ?scope ?captured ?args ?value]
+ [::&&/Expression [::&&/lambda (rest ?scope)
+ (into {} (for [[?name ?sub-syntax] ?captured]
+ [?name (partial-f ?sub-syntax)]))
+ ?args
+ ?value]
+ ?type]
+
+ [::&&/call ?func ?args]
+ [::&&/Expression [::&&/call (partial-f ?func) (map partial-f ?args)] ?type]
+
+ [::&&/exec ?asts]
+ [::&&/Expression [::&&/exec (map partial-f ?asts)] ?type]
+
+ [::&&/jvm-getstatic _ _]
+ syntax
+
+ [::&&/jvm-invokevirtual ?class ?method ?arg-classes ?obj ?args]
+ [::&&/Expression [::&&/jvm-invokevirtual ?class ?method ?arg-classes
+ (partial-f ?obj)
+ (map partial-f ?args)]
+ ?type]
+
+ ;; Integer arithmetic
+ [::&&/jvm-iadd ?x ?y]
+ [::&&/Expression [::&&/jvm-iadd (partial-f ?x) (partial-f ?y)] ?type]
+
+ [::&&/jvm-isub ?x ?y]
+ [::&&/Expression [::&&/jvm-isub (partial-f ?x) (partial-f ?y)] ?type]
+
+ [::&&/jvm-imul ?x ?y]
+ [::&&/Expression [::&&/jvm-imul (partial-f ?x) (partial-f ?y)] ?type]
+
+ [::&&/jvm-idiv ?x ?y]
+ [::&&/Expression [::&&/jvm-idiv (partial-f ?x) (partial-f ?y)] ?type]
+
+ [::&&/jvm-irem ?x ?y]
+ [::&&/Expression [::&&/jvm-irem (partial-f ?x) (partial-f ?y)] ?type]
+
+ ;; Long arithmetic
+ [::&&/jvm-ladd ?x ?y]
+ [::&&/Expression [::&&/jvm-ladd (partial-f ?x) (partial-f ?y)] ?type]
+
+ [::&&/jvm-lsub ?x ?y]
+ [::&&/Expression [::&&/jvm-lsub (partial-f ?x) (partial-f ?y)] ?type]
+
+ [::&&/jvm-lmul ?x ?y]
+ [::&&/Expression [::&&/jvm-lmul (partial-f ?x) (partial-f ?y)] ?type]
+
+ [::&&/jvm-ldiv ?x ?y]
+ [::&&/Expression [::&&/jvm-ldiv (partial-f ?x) (partial-f ?y)] ?type]
+
+ [::&&/jvm-lrem ?x ?y]
+ [::&&/Expression [::&&/jvm-lrem (partial-f ?x) (partial-f ?y)] ?type]
+
+ ;; Float arithmetic
+ [::&&/jvm-fadd ?x ?y]
+ [::&&/Expression [::&&/jvm-fadd (partial-f ?x) (partial-f ?y)] ?type]
+
+ [::&&/jvm-fsub ?x ?y]
+ [::&&/Expression [::&&/jvm-fsub (partial-f ?x) (partial-f ?y)] ?type]
+
+ [::&&/jvm-fmul ?x ?y]
+ [::&&/Expression [::&&/jvm-fmul (partial-f ?x) (partial-f ?y)] ?type]
+
+ [::&&/jvm-fdiv ?x ?y]
+ [::&&/Expression [::&&/jvm-fdiv (partial-f ?x) (partial-f ?y)] ?type]
+
+ [::&&/jvm-frem ?x ?y]
+ [::&&/Expression [::&&/jvm-frem (partial-f ?x) (partial-f ?y)] ?type]
+
+ ;; Double arithmetic
+ [::&&/jvm-dadd ?x ?y]
+ [::&&/Expression [::&&/jvm-dadd (partial-f ?x) (partial-f ?y)] ?type]
+
+ [::&&/jvm-dsub ?x ?y]
+ [::&&/Expression [::&&/jvm-dsub (partial-f ?x) (partial-f ?y)] ?type]
+
+ [::&&/jvm-dmul ?x ?y]
+ [::&&/Expression [::&&/jvm-dmul (partial-f ?x) (partial-f ?y)] ?type]
+
+ [::&&/jvm-ddiv ?x ?y]
+ [::&&/Expression [::&&/jvm-ddiv (partial-f ?x) (partial-f ?y)] ?type]
+
+ [::&&/jvm-drem ?x ?y]
+ [::&&/Expression [::&&/jvm-drem (partial-f ?x) (partial-f ?y)] ?type]
+ ))))
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index 4dc949d05..b80321820 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -47,9 +47,8 @@
))
))
-(defn analyse-call [analyse ?fn ?args]
- (exec [=fn (&&/analyse-1 analyse ?fn)
- loader &/loader]
+(defn analyse-call [analyse =fn ?args]
+ (exec [loader &/loader]
(match =fn
[::&&/Expression =fn-form =fn-type]
(match =fn-form
@@ -62,29 +61,22 @@
_ (doseq [ast macro-expansion]
(prn '=> ast))]
(mapcat-m analyse macro-expansion))
- (exec [=args (mapcat-m analyse ?args)
- :let [[needs-num =return-type] (match =fn-type
- [::&type/function ?fargs ?freturn]
- (let [needs-num (count ?fargs)
- provides-num (count =args)]
- (if (> needs-num provides-num)
- [needs-num [::&type/function (drop provides-num ?fargs) ?freturn]]
- [needs-num &type/+dont-care-type+])))]]
- (return (list [::&&/Expression [::&&/static-call needs-num =fn =args] =return-type])))))
+ (exec [=args (mapcat-m analyse ?args)]
+ (return (list [::&&/Expression [::&&/call =fn =args] &type/+dont-care-type+])))))
_
(exec [=args (mapcat-m analyse ?args)]
(return (list [::&&/Expression [::&&/call =fn =args] &type/+dont-care-type+]))))
:else
- (fail "Can't call something without a type."))
+ (fail "[Analyser Error] Can't call a statement!"))
))
(defn analyse-case [analyse ?variant ?branches]
(prn 'analyse-case ?variant ?branches)
(exec [:let [num-branches (count ?branches)]
_ (assert! (and (> num-branches 0) (even? num-branches))
- "Unbalanced branches in \"case'\" expression.")
+ "[Analyser Error] Unbalanced branches in \"case'\" expression.")
:let [branches (partition 2 ?branches)
locals-per-branch (map (comp &&case/locals first) branches)
max-locals (reduce max 0 (map count locals-per-branch))]
@@ -114,7 +106,7 @@
(&type/clean =lambda-type))
:let [=lambda-form (match =body
[::&&/Expression [::&&/lambda ?sub-scope ?sub-captured ?sub-args ?sub-body] _]
- [::&&/lambda =scope =captured (cons ?arg ?sub-args) (&&lambda/raise-expr ?arg ?sub-body)]
+ [::&&/lambda =scope =captured (cons ?arg ?sub-args) (&&lambda/raise-expr =scope ?arg ?sub-body)]
_
[::&&/lambda =scope =captured (list ?arg) =body])
@@ -125,19 +117,19 @@
;; (prn 'analyse-def ?name ?value)
(exec [module-name &/get-module-name]
(if-m (&&def/defined? module-name ?name)
- (fail (str "Can't redefine " ?name))
+ (fail (str "[Analyser Error] Can't redefine " ?name))
(exec [=value (&&/analyse-1 analyse ?value)
=value (match =value
[::&&/Expression =value-form =value-type]
(return (match =value-form
[::&&/lambda ?old-scope ?env ?args ?body]
- [::&&/Expression [::&&/lambda (list module-name ?name) ?env ?args ?body] =value-type]
+ [::&&/Expression [::&&/lambda (list module-name ?name) ?env ?args (&&lambda/re-scope (list module-name ?name) ?body)] =value-type]
_
=value))
_
- (fail ""))
+ (fail "[Analyser Error] def value must be an expression!"))
=value-type (&&/expr-type =value)
_ (&&def/define module-name ?name =value-type)]
(return (list [::&&/Statement [::&&/def ?name =value]]))))))
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index c32d1218a..8681aebe4 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -75,8 +75,8 @@
[::&a/lambda ?scope ?frame ?args ?body]
(&&lambda/compile-lambda compile-expression ?type ?scope ?frame ?args ?body false true)
- [::&a/self ?assumed-args]
- (&&lux/compile-self-call compile-expression ?assumed-args)
+ [::&a/self ?scope ?assumed-args]
+ (&&lux/compile-self-call compile-expression ?scope ?assumed-args)
;; Integer arithmetic
[::&a/jvm-iadd ?x ?y]
@@ -221,7 +221,8 @@
(println (str "Compilation complete! " (pr-str modules)))
[::&/failure ?message]
- (assert false ?message)))
+ (do (prn 'compile-all '?message ?message)
+ (assert false ?message))))
(comment
(compile-all ["lux"])
diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj
index acddcf8cb..a141cecc3 100644
--- a/src/lux/compiler/host.clj
+++ b/src/lux/compiler/host.clj
@@ -113,6 +113,7 @@
(return nil)))
(defn compile-jvm-invokevirtual [compile *type* ?class ?method ?classes ?object ?args]
+ (prn 'compile-jvm-invokevirtual ?classes *type*)
(exec [*writer* &/get-writer
:let [method-sig (str "(" (reduce str "" (map &host/->type-signature ?classes)) ")" (&host/->java-sig *type*))]
_ (compile ?object)
diff --git a/src/lux/compiler/lambda.clj b/src/lux/compiler/lambda.clj
index 5c83b159e..b24ab9fc6 100644
--- a/src/lux/compiler/lambda.clj
+++ b/src/lux/compiler/lambda.clj
@@ -52,7 +52,7 @@
[::&analyser/captured ?closure-id ?captured-id ?source])
(doseq [[?name ?captured] closed-over])))
(-> (doto (.visitVarInsn Opcodes/ALOAD 0)
- (.visitInsn Opcodes/ICONST_0)
+ (.visitVarInsn Opcodes/ILOAD 1)
(.visitFieldInsn Opcodes/PUTFIELD class-name "_counter" counter-sig)
(-> (doto (.visitVarInsn Opcodes/ALOAD 0)
(.visitVarInsn Opcodes/ALOAD (+ clo_idx offset))
diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj
index cbab1fdd4..bd09b603f 100644
--- a/src/lux/compiler/lux.clj
+++ b/src/lux/compiler/lux.clj
@@ -27,7 +27,7 @@
module-name &/get-module-name
:let [outer-class (&host/->class module-name)
datum-sig (&host/->type-signature "java.lang.Object")
- current-class (&host/location (list ?name outer-class))
+ current-class (&host/location (list outer-class ?name))
_ (.visitInnerClass *writer* current-class outer-class nil (+ Opcodes/ACC_STATIC Opcodes/ACC_SYNTHETIC))
=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
(.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_SUPER)
@@ -125,7 +125,7 @@
(defn compile-global [compile *type* ?owner-class ?name]
(exec [*writer* &/get-writer
- :let [_ (.visitFieldInsn *writer* Opcodes/GETSTATIC (&host/->class (&host/location (list ?name ?owner-class))) "_datum" "Ljava/lang/Object;")]]
+ :let [_ (.visitFieldInsn *writer* Opcodes/GETSTATIC (&host/->class (&host/location (list ?owner-class ?name))) "_datum" "Ljava/lang/Object;")]]
(return nil)))
(defn compile-call [compile *type* ?fn ?args]
@@ -144,7 +144,7 @@
:let [_ (match (:form ?fn)
[::&a/global ?owner-class ?fn-name]
(let [arg-sig (&host/->type-signature "java.lang.Object")
- call-class (&host/location (list ?fn-name ?owner-class))
+ call-class (&host/location (list ?owner-class ?fn-name))
provides-num (count ?args)]
(if (>= provides-num ?needs-num)
(let [impl-sig (str "(" (reduce str "" (repeat ?needs-num arg-sig)) ")" arg-sig)]
@@ -183,9 +183,24 @@
_
(fail "Can only define expressions."))))
-(defn compile-self-call [compile ?assumed-args]
+(defn compile-self-call [compile ?scope ?assumed-args]
+ (prn 'compile-self-call ?scope ?assumed-args)
(exec [*writer* &/get-writer
- :let [_ (.visitVarInsn *writer* Opcodes/ALOAD 0)]
+ :let [lambda-class (&host/location ?scope)]
+ :let [_ (doto *writer*
+ (.visitTypeInsn Opcodes/NEW lambda-class)
+ (.visitInsn Opcodes/DUP))]
+ :let [num-args (if (= '("lux" "fold") ?scope)
+ 3
+ (count ?assumed-args))
+ init-signature (str "(" (if (> num-args 1)
+ (reduce str "I" (repeat (dec num-args) (&host/->type-signature "java.lang.Object"))))
+ ")"
+ "V")
+ _ (do (when (> num-args 1)
+ (.visitInsn *writer* Opcodes/ICONST_0)
+ (&&/add-nulls *writer* (dec num-args)))
+ (.visitMethodInsn *writer* Opcodes/INVOKESPECIAL lambda-class "<init>" init-signature))]
_ (map-m (fn [arg]
(exec [ret (compile arg)
:let [_ (.visitMethodInsn *writer* Opcodes/INVOKEINTERFACE (&host/->class &host/function-class) "apply" &&/apply-signature)]]
diff --git a/src/lux/host.clj b/src/lux/host.clj
index 9cf4f85c0..05a2b53ba 100644
--- a/src/lux/host.clj
+++ b/src/lux/host.clj
@@ -55,7 +55,7 @@
(defn full-class-name [class-name]
(exec [=class (full-class class-name)]
- (.getName class-name)))
+ (return (.getName =class))))
(defn ->class [class]
(string/replace class #"\." "/"))
@@ -99,26 +99,27 @@
(defn extract-jvm-param [token]
(match token
- [::&parser/ident ?ident]
+ [::&parser/Ident ?ident]
(full-class-name ?ident)
- [::&parser/form ([[::&parser/ident "Array"] [::&parser/ident ?inner]] :seq)]
+ [::&parser/Form ([[::&parser/Ident "Array"] [::&parser/Ident ?inner]] :seq)]
(exec [=inner (full-class-name ?inner)]
(return (str "[L" (->class =inner) ";")))
_
- (fail "")))
+ (fail (str "[Host] Unknown JVM param: " (pr-str token)))))
(do-template [<name> <static?>]
(defn <name> [target field]
- (if-let [type* (first (for [=field (.getFields target)
- :when (and (= target (.getDeclaringClass =field))
- (= field (.getName =field))
- (= <static?> (java.lang.reflect.Modifier/isStatic (.getModifiers =field))))]
- (.getType =field)))]
- (exec [=type (class->type type*)]
- (return =type))
- (fail (str "[Analyser Error] Field does not exist: " target field))))
+ (let [target (Class/forName target)]
+ (if-let [type* (first (for [=field (.getFields target)
+ :when (and (= target (.getDeclaringClass =field))
+ (= field (.getName =field))
+ (= <static?> (java.lang.reflect.Modifier/isStatic (.getModifiers =field))))]
+ (.getType =field)))]
+ (exec [=type (class->type type*)]
+ (return =type))
+ (fail (str "[Analyser Error] Field does not exist: " target field)))))
lookup-static-field true
lookup-field false
@@ -126,14 +127,17 @@
(do-template [<name> <static?>]
(defn <name> [target method-name args]
- (if-let [method (first (for [=method (.getMethods target)
- :when (and (= target (.getDeclaringClass =method))
- (= method-name (.getName =method))
- (= <static?> (java.lang.reflect.Modifier/isStatic (.getModifiers =method))))]
- =method))]
- (exec [=method (method->type method)]
- (return =method))
- (fail (str "[Analyser Error] Method does not exist: " target method-name))))
+ (let [target (Class/forName target)]
+ (if-let [method (first (for [=method (.getMethods target)
+ :let [_ (prn '<name> '=method =method (mapv #(.getName %) (.getParameterTypes =method)))]
+ :when (and (= target (.getDeclaringClass =method))
+ (= method-name (.getName =method))
+ (= <static?> (java.lang.reflect.Modifier/isStatic (.getModifiers =method)))
+ (= args (mapv #(.getName %) (.getParameterTypes =method))))]
+ =method))]
+ (exec [=method (method->type method)]
+ (return =method))
+ (fail (str "[Analyser Error] Method does not exist: " target method-name)))))
lookup-static-method true
lookup-virtual-method false
diff --git a/src/lux/macro.clj b/src/lux/macro.clj
index 76784a4a9..447387649 100644
--- a/src/lux/macro.clj
+++ b/src/lux/macro.clj
@@ -74,9 +74,10 @@
first
(.newInstance (to-array [(int 0) nil]))
((fn [macro] (prn 'macro macro "#1") macro))
- (.impl (->lux+ ->lux loader tokens) nil)
- ;; ((fn [macro] (prn 'macro macro "#2") macro))
- ;; (.apply nil)
+ (.apply (->lux+ ->lux loader tokens))
+ ;; (.impl (->lux+ ->lux loader tokens) nil)
+ ((fn [macro] (prn 'macro macro "#2") macro))
+ (.apply nil)
((fn [macro] (prn 'macro macro "#3") macro))
;; (.apply nil)
;; ((fn [macro] (prn 'macro macro "#4?") macro))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-23 17:48:43 +0000