aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorEduardo Julian2015-03-08 02:20:51 -0400
committerEduardo Julian2015-03-08 02:20:51 -0400
commit9b0c07dbf78bbdb6e13fbbd44e02fe322d9f145c (patch)
tree0cfc071a8c96cca29f0a9fa299e9e373cf3ed7fb /src
parentc7fc7e1ffa91db4a563a48d53743a5e0752779ea (diff)
- Changed once more the syntax of the prefix for host special forms. It's now "jvm-" instead of "jvm;"
- Fixed the bug where the same local vars/registers were getting registered more than once and the class-verifier complained. - Fixed a bug where the "end label" for pattern-matching bodies was never inserted. - Simplified the analyser by removing "self" calls and having self be just a local for the "this" object (register 0). - Removed the lambda-folding optimization. - The compiler state now holds and environment for naming globally-scoped lambdas.
Diffstat (limited to 'src')
-rw-r--r--src/lux.clj2
-rw-r--r--src/lux/analyser.clj60
-rw-r--r--src/lux/analyser/case.clj4
-rw-r--r--src/lux/analyser/env.clj12
-rw-r--r--src/lux/analyser/lambda.clj267
-rw-r--r--src/lux/analyser/lux.clj76
-rw-r--r--src/lux/compiler.clj7
-rw-r--r--src/lux/compiler/base.clj105
-rw-r--r--src/lux/compiler/case.clj7
-rw-r--r--src/lux/compiler/lambda.clj194
-rw-r--r--src/lux/compiler/lux.clj91
-rw-r--r--src/lux/macro.clj5
-rw-r--r--src/lux/optimizer.clj1
13 files changed, 260 insertions, 571 deletions
diff --git a/src/lux.clj b/src/lux.clj
index 66cb929a4..ce843d0cd 100644
--- a/src/lux.clj
+++ b/src/lux.clj
@@ -11,7 +11,7 @@
;; TODO: throw, try, catch, finally
;; TODO: Allow setting fields.
;; TODO: monitor enter & monitor exit.
- ;; TODO:
+ ;; TODO: Add column & line numbers for syntactic elements.
;; TODO:
;; TODO:
;; TODO:
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index 4ddd8ecd1..3575c3007 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -63,100 +63,100 @@
(&&host/analyse-exec analyse-ast ?exprs)
;; Integer arithmetic
- [::&parser/Form ([[::&parser/Ident "jvm;iadd"] ?x ?y] :seq)]
+ [::&parser/Form ([[::&parser/Ident "jvm-iadd"] ?x ?y] :seq)]
(&&host/analyse-jvm-iadd analyse-ast ?x ?y)
- [::&parser/Form ([[::&parser/Ident "jvm;isub"] ?x ?y] :seq)]
+ [::&parser/Form ([[::&parser/Ident "jvm-isub"] ?x ?y] :seq)]
(&&host/analyse-jvm-isub analyse-ast ?x ?y)
- [::&parser/Form ([[::&parser/Ident "jvm;imul"] ?x ?y] :seq)]
+ [::&parser/Form ([[::&parser/Ident "jvm-imul"] ?x ?y] :seq)]
(&&host/analyse-jvm-imul analyse-ast ?x ?y)
- [::&parser/Form ([[::&parser/Ident "jvm;idiv"] ?x ?y] :seq)]
+ [::&parser/Form ([[::&parser/Ident "jvm-idiv"] ?x ?y] :seq)]
(&&host/analyse-jvm-idiv analyse-ast ?x ?y)
- [::&parser/Form ([[::&parser/Ident "jvm;irem"] ?x ?y] :seq)]
+ [::&parser/Form ([[::&parser/Ident "jvm-irem"] ?x ?y] :seq)]
(&&host/analyse-jvm-irem analyse-ast ?x ?y)
;; Long arithmetic
- [::&parser/Form ([[::&parser/Ident "jvm;ladd"] ?x ?y] :seq)]
+ [::&parser/Form ([[::&parser/Ident "jvm-ladd"] ?x ?y] :seq)]
(&&host/analyse-jvm-ladd analyse-ast ?x ?y)
- [::&parser/Form ([[::&parser/Ident "jvm;lsub"] ?x ?y] :seq)]
+ [::&parser/Form ([[::&parser/Ident "jvm-lsub"] ?x ?y] :seq)]
(&&host/analyse-jvm-lsub analyse-ast ?x ?y)
- [::&parser/Form ([[::&parser/Ident "jvm;lmul"] ?x ?y] :seq)]
+ [::&parser/Form ([[::&parser/Ident "jvm-lmul"] ?x ?y] :seq)]
(&&host/analyse-jvm-lmul analyse-ast ?x ?y)
- [::&parser/Form ([[::&parser/Ident "jvm;ldiv"] ?x ?y] :seq)]
+ [::&parser/Form ([[::&parser/Ident "jvm-ldiv"] ?x ?y] :seq)]
(&&host/analyse-jvm-ldiv analyse-ast ?x ?y)
- [::&parser/Form ([[::&parser/Ident "jvm;lrem"] ?x ?y] :seq)]
+ [::&parser/Form ([[::&parser/Ident "jvm-lrem"] ?x ?y] :seq)]
(&&host/analyse-jvm-lrem analyse-ast ?x ?y)
;; Float arithmetic
- [::&parser/Form ([[::&parser/Ident "jvm;fadd"] ?x ?y] :seq)]
+ [::&parser/Form ([[::&parser/Ident "jvm-fadd"] ?x ?y] :seq)]
(&&host/analyse-jvm-fadd analyse-ast ?x ?y)
- [::&parser/Form ([[::&parser/Ident "jvm;fsub"] ?x ?y] :seq)]
+ [::&parser/Form ([[::&parser/Ident "jvm-fsub"] ?x ?y] :seq)]
(&&host/analyse-jvm-fsub analyse-ast ?x ?y)
- [::&parser/Form ([[::&parser/Ident "jvm;fmul"] ?x ?y] :seq)]
+ [::&parser/Form ([[::&parser/Ident "jvm-fmul"] ?x ?y] :seq)]
(&&host/analyse-jvm-fmul analyse-ast ?x ?y)
- [::&parser/Form ([[::&parser/Ident "jvm;fdiv"] ?x ?y] :seq)]
+ [::&parser/Form ([[::&parser/Ident "jvm-fdiv"] ?x ?y] :seq)]
(&&host/analyse-jvm-fdiv analyse-ast ?x ?y)
- [::&parser/Form ([[::&parser/Ident "jvm;frem"] ?x ?y] :seq)]
+ [::&parser/Form ([[::&parser/Ident "jvm-frem"] ?x ?y] :seq)]
(&&host/analyse-jvm-frem analyse-ast ?x ?y)
;; Double arithmetic
- [::&parser/Form ([[::&parser/Ident "jvm;dadd"] ?x ?y] :seq)]
+ [::&parser/Form ([[::&parser/Ident "jvm-dadd"] ?x ?y] :seq)]
(&&host/analyse-jvm-dadd analyse-ast ?x ?y)
- [::&parser/Form ([[::&parser/Ident "jvm;dsub"] ?x ?y] :seq)]
+ [::&parser/Form ([[::&parser/Ident "jvm-dsub"] ?x ?y] :seq)]
(&&host/analyse-jvm-dsub analyse-ast ?x ?y)
- [::&parser/Form ([[::&parser/Ident "jvm;dmul"] ?x ?y] :seq)]
+ [::&parser/Form ([[::&parser/Ident "jvm-dmul"] ?x ?y] :seq)]
(&&host/analyse-jvm-dmul analyse-ast ?x ?y)
- [::&parser/Form ([[::&parser/Ident "jvm;ddiv"] ?x ?y] :seq)]
+ [::&parser/Form ([[::&parser/Ident "jvm-ddiv"] ?x ?y] :seq)]
(&&host/analyse-jvm-ddiv analyse-ast ?x ?y)
- [::&parser/Form ([[::&parser/Ident "jvm;drem"] ?x ?y] :seq)]
+ [::&parser/Form ([[::&parser/Ident "jvm-drem"] ?x ?y] :seq)]
(&&host/analyse-jvm-drem analyse-ast ?x ?y)
;; Fields & methods
- [::&parser/Form ([[::&parser/Ident "jvm;getstatic"] [::&parser/Ident ?class] [::&parser/Text ?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/Text ?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)]
+ [::&parser/Form ([[::&parser/Ident "jvm-invokestatic"] [::&parser/Ident ?class] [::&parser/Text ?method] [::&parser/Tuple ?classes] [::&parser/Tuple ?args]] :seq)]
(&&host/analyse-jvm-invokestatic analyse-ast ?class ?method ?classes ?args)
- [::&parser/Form ([[::&parser/Ident "jvm;invokevirtual"] [::&parser/Ident ?class] [::&parser/Text ?method] [::&parser/Tuple ?classes] ?object [::&parser/Tuple ?args]] :seq)]
+ [::&parser/Form ([[::&parser/Ident "jvm-invokevirtual"] [::&parser/Ident ?class] [::&parser/Text ?method] [::&parser/Tuple ?classes] ?object [::&parser/Tuple ?args]] :seq)]
(&&host/analyse-jvm-invokevirtual analyse-ast ?class ?method ?classes ?object ?args)
;; Arrays
- [::&parser/Form ([[::&parser/Ident "jvm;new"] [::&parser/Ident ?class] [::&parser/Tuple ?classes] [::&parser/Tuple ?args]] :seq)]
+ [::&parser/Form ([[::&parser/Ident "jvm-new"] [::&parser/Ident ?class] [::&parser/Tuple ?classes] [::&parser/Tuple ?args]] :seq)]
(&&host/analyse-jvm-new analyse-ast ?class ?classes ?args)
- [::&parser/Form ([[::&parser/Ident "jvm;new-array"] [::&parser/Ident ?class] [::&parser/Int ?length]] :seq)]
+ [::&parser/Form ([[::&parser/Ident "jvm-new-array"] [::&parser/Ident ?class] [::&parser/Int ?length]] :seq)]
(&&host/analyse-jvm-new-array analyse-ast ?class ?length)
- [::&parser/Form ([[::&parser/Ident "jvm;aastore"] ?array [::&parser/Int ?idx] ?elem] :seq)]
+ [::&parser/Form ([[::&parser/Ident "jvm-aastore"] ?array [::&parser/Int ?idx] ?elem] :seq)]
(&&host/analyse-jvm-aastore analyse-ast ?array ?idx ?elem)
- [::&parser/Form ([[::&parser/Ident "jvm;aaload"] ?array [::&parser/Int ?idx]] :seq)]
+ [::&parser/Form ([[::&parser/Ident "jvm-aaload"] ?array [::&parser/Int ?idx]] :seq)]
(&&host/analyse-jvm-aaload analyse-ast ?array ?idx)
;; Classes & interfaces
- [::&parser/Form ([[::&parser/Ident "jvm;class"] [::&parser/Ident ?name] [::&parser/Ident ?super-class] [::&parser/Tuple ?fields]] :seq)]
+ [::&parser/Form ([[::&parser/Ident "jvm-class"] [::&parser/Ident ?name] [::&parser/Ident ?super-class] [::&parser/Tuple ?fields]] :seq)]
(&&host/analyse-jvm-class analyse-ast ?name ?super-class ?fields)
- [::&parser/Form ([[::&parser/Ident "jvm;interface"] [::&parser/Ident ?name] & ?members] :seq)]
+ [::&parser/Form ([[::&parser/Ident "jvm-interface"] [::&parser/Ident ?name] & ?members] :seq)]
(&&host/analyse-jvm-interface analyse-ast ?name ?members)
_
diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj
index 639395f33..5227bfcb0 100644
--- a/src/lux/analyser/case.clj
+++ b/src/lux/analyser/case.clj
@@ -26,9 +26,9 @@
(defn analyse-branch [analyse max-registers [bindings body]]
;; (prn 'analyse-branch max-registers bindings body)
(reduce (fn [body* name]
- (&env/with-local name :local &type/+dont-care-type+ body*))
+ (&env/with-local name &type/+dont-care-type+ body*))
(reduce (fn [body* _]
- (&env/with-local "#" :local &type/+dont-care-type+ body*))
+ (&env/with-local "" &type/+dont-care-type+ body*))
(&&/analyse-1 analyse body)
(range (- max-registers (count bindings))))
(reverse bindings)))
diff --git a/src/lux/analyser/env.clj b/src/lux/analyser/env.clj
index 55205e597..5b52e3db3 100644
--- a/src/lux/analyser/env.clj
+++ b/src/lux/analyser/env.clj
@@ -10,18 +10,12 @@
(fn [state]
[::&/ok [state (-> state ::&/local-envs first :locals :counter)]]))
-(defn with-local [name mode type body]
+(defn with-local [name type body]
(fn [state]
(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]))
- (let [bound-unit (case mode
- :local [::&&/local (get-in top [:locals :counter])]
-
- ;; else
- [::&&/self (second mode) (list)]
- )]
+ (let [bound-unit [::&&/local (get-in top [:locals :counter])]]
(cons (-> top
(update-in [:locals :counter] inc)
(assoc-in [:locals :mappings name] [::&&/Expression bound-unit type]))
@@ -40,7 +34,7 @@
(defn with-locals [locals monad]
(reduce (fn [inner [label elem]]
- (with-local label :local elem inner))
+ (with-local label elem inner))
monad
(reverse locals)))
diff --git a/src/lux/analyser/lambda.clj b/src/lux/analyser/lambda.clj
index c0af66050..61daa5e5f 100644
--- a/src/lux/analyser/lambda.clj
+++ b/src/lux/analyser/lambda.clj
@@ -10,8 +10,8 @@
(defn with-lambda [self self-type arg arg-type body]
(&/with-closure
(exec [scope-name &/get-scope-name]
- (&env/with-local self [:self scope-name] self-type
- (&env/with-local arg :local arg-type
+ (&env/with-local self self-type
+ (&env/with-local arg arg-type
(exec [=return body
=captured &env/captured-vars]
(return [scope-name =captured =return])))))))
@@ -23,266 +23,3 @@
[register* (update-in frame [:closure] #(-> %
(update-in [:counter] inc)
(assoc-in [:mappings ident] register*)))])))
-
-(defn raise-expr [out-scope arg syntax]
- (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 raise-expr out-scope arg) ?members)] ?type]
-
- [::&&/variant ?tag ?value]
- [::&&/Expression [::&&/variant ?tag (raise-expr out-scope arg ?value)] ?type]
-
- [::&&/local ?idx]
- [::&&/Expression [::&&/local (inc ?idx)] ?type]
-
- [::&&/captured _ _ ?source]
- ?source
-
- [::&&/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 out-scope arg ?variant) (inc ?base) ?num-bindings
- (for [[?pattern ?body] ?branches]
- [?pattern (raise-expr out-scope arg ?body)])]
- ?type]
-
- [::&&/lambda ?scope ?captured ?args ?value]
- [::&&/Expression [::&&/lambda (rest ?scope)
- (into {} (for [[?name ?sub-syntax] ?captured]
- [?name (raise-expr out-scope arg ?sub-syntax)]))
- ?args
- ?value]
- ?type]
-
- [::&&/call ?func ?args]
- [::&&/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 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 out-scope arg ?obj)
- (map (partial raise-expr out-scope arg) ?args)]
- ?type]
-
- ;; Integer arithmetic
- [::&&/jvm-iadd ?x ?y]
- [::&&/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 out-scope arg ?x) (raise-expr out-scope arg ?y)] ?type]
-
- [::&&/jvm-imul ?x ?y]
- [::&&/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 out-scope arg ?x) (raise-expr out-scope arg ?y)] ?type]
-
- [::&&/jvm-irem ?x ?y]
- [::&&/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 out-scope arg ?x) (raise-expr out-scope arg ?y)] ?type]
-
- [::&&/jvm-lsub ?x ?y]
- [::&&/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 out-scope arg ?x) (raise-expr out-scope arg ?y)] ?type]
-
- [::&&/jvm-ldiv ?x ?y]
- [::&&/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 out-scope arg ?x) (raise-expr out-scope arg ?y)] ?type]
-
- ;; Float arithmetic
- [::&&/jvm-fadd ?x ?y]
- [::&&/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 out-scope arg ?x) (raise-expr out-scope arg ?y)] ?type]
-
- [::&&/jvm-fmul ?x ?y]
- [::&&/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 out-scope arg ?x) (raise-expr out-scope arg ?y)] ?type]
-
- [::&&/jvm-frem ?x ?y]
- [::&&/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 out-scope arg ?x) (raise-expr out-scope arg ?y)] ?type]
-
- [::&&/jvm-dsub ?x ?y]
- [::&&/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 out-scope arg ?x) (raise-expr out-scope arg ?y)] ?type]
-
- [::&&/jvm-ddiv ?x ?y]
- [::&&/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 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 5e81cae0e..570048dcd 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -23,29 +23,34 @@
(return (list [::&&/Expression [::&&/tuple =elems] [::&type/Tuple =elems-types]]))))
(defn analyse-ident [analyse ident]
- (fn [state]
- (let [[top & stack*] (::&/local-envs state)]
- (if-let [=bound (or (get-in top [:locals :mappings ident])
- (get-in top [:closure :mappings ident]))]
- [::&/ok [state (list =bound)]]
- (let [no-binding? #(and (-> % :locals :mappings (contains? ident) not)
- (-> % :closure :mappings (contains? ident) not))
- [inner outer] (split-with no-binding? stack*)]
- (if (empty? outer)
- (if-let [global (get-in state [::&/global-env ident])]
- [::&/ok [state (list global)]]
- [::&/failure (str "[Analyser Error] Unresolved identifier: " ident)])
- (let [[=local inner*] (reduce (fn [[register new-inner] frame]
- (let [[register* frame*] (&&lambda/close-over (:name frame) ident register frame)]
- [register* (cons frame* new-inner)]))
- [(or (get-in (first outer) [:locals :mappings ident])
- (get-in (first outer) [:closure :mappings ident]))
- '()]
- (reverse (cons top inner)))]
- [::&/ok [(assoc state ::&/local-envs (concat inner* outer)) (list =local)]])
- ))
- ))
- ))
+ (exec [module-name &/get-module-name]
+ (fn [state]
+ (let [[top & stack*] (::&/local-envs state)]
+ (if-let [=bound (or (get-in top [:locals :mappings ident])
+ (get-in top [:closure :mappings ident]))]
+ [::&/ok [state (list =bound)]]
+ (let [no-binding? #(and (-> % :locals :mappings (contains? ident) not)
+ (-> % :closure :mappings (contains? ident) not))
+ [inner outer] (split-with no-binding? stack*)]
+ (if (empty? outer)
+ (if-let [global (get-in state [::&/global-env ident])]
+ [::&/ok [state (list global)]]
+ [::&/failure (str "[Analyser Error] Unresolved identifier: " ident)])
+ (let [in-stack (cons top inner)
+ scopes (rest (reductions #(cons (:name %2) %1) (map :name outer) (reverse in-stack)))
+ _ (prn 'in-stack module-name ident (map :name in-stack) scopes)
+ [=local inner*] (reduce (fn [[register new-inner] [frame in-scope]]
+ (let [[register* frame*] (&&lambda/close-over (cons module-name (reverse in-scope)) ident register frame)]
+ [register* (cons frame* new-inner)]))
+ [(or (get-in (first outer) [:locals :mappings ident])
+ (get-in (first outer) [:closure :mappings ident]))
+ '()]
+ (map vector (reverse in-stack) scopes)
+ )]
+ [::&/ok [(assoc state ::&/local-envs (concat inner* outer)) (list =local)]])
+ ))
+ ))
+ )))
(defn analyse-call [analyse =fn ?args]
(exec [loader &/loader]
@@ -84,7 +89,7 @@
;; :let [_ (prn '[branches locals-per-branch max-locals] [branches locals-per-branch max-locals])]
base-register &&env/next-local-idx
;; :let [_ (prn 'base-register base-register)]
- =variant (reduce (fn [body* _] (&&env/with-local "#" :local &type/+dont-care-type+ body*))
+ =variant (reduce (fn [body* _] (&&env/with-local "" &type/+dont-care-type+ body*))
(&&/analyse-1 analyse ?variant)
(range max-locals))
;; :let [_ (prn '=variant =variant)]
@@ -104,16 +109,8 @@
(&&/analyse-1 analyse ?body))
=body-type (&&/expr-type =body)
=lambda-type (exec [_ (&type/solve =return =body-type)]
- (&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 =scope ?arg ?sub-body)]
-
- _
- [::&&/lambda =scope =captured (list ?arg) =body])
- ;; _ (prn '=lambda-form =lambda-form)
- ]]
- (return (list [::&&/Expression =lambda-form =lambda-type]))))
+ (&type/clean =lambda-type))]
+ (return (list [::&&/Expression [::&&/lambda =scope =captured ?arg =body] =lambda-type]))))
(defn analyse-def [analyse ?name ?value]
;; (prn 'analyse-def ?name ?value)
@@ -121,17 +118,6 @@
(if-m (&&def/defined? module-name ?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 (&&lambda/re-scope (list module-name ?name) ?body)] =value-type]
-
- _
- =value))
-
- _
- (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 afc232843..503f041ea 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -69,11 +69,8 @@
[::&a/case ?variant ?base-register ?num-registers ?branches]
(&&case/compile-case compile-expression ?type ?variant ?base-register ?num-registers ?branches)
- [::&a/lambda ?scope ?frame ?args ?body]
- (&&lambda/compile-lambda compile-expression ?type ?scope ?frame ?args ?body false true)
-
- [::&a/self ?scope ?assumed-args]
- (&&lux/compile-self-call compile-expression ?scope ?assumed-args)
+ [::&a/lambda ?scope ?env ?args ?body]
+ (&&lambda/compile-lambda compile-expression ?scope ?env ?args ?body)
;; Integer arithmetic
[::&a/jvm-iadd ?x ?y]
diff --git a/src/lux/compiler/base.clj b/src/lux/compiler/base.clj
index 28c793e10..394f77d0b 100644
--- a/src/lux/compiler/base.clj
+++ b/src/lux/compiler/base.clj
@@ -1,24 +1,22 @@
(ns lux.compiler.base
(:require [clojure.string :as string]
+ [clojure.core.match :refer [match]]
(lux [base :as & :refer [exec return* return fail fail*
repeat-m exhaust-m try-m try-all-m map-m reduce-m
apply-m
- normalize-ident]]))
+ normalize-ident]])
+ [lux.analyser.base :as &a])
(:import (org.objectweb.asm Opcodes
Label
ClassWriter
MethodVisitor)))
-;; [Resources]
+;; [Exports]
(def local-prefix "l")
(def partial-prefix "p")
(def closure-prefix "c")
(def apply-signature "(Ljava/lang/Object;)Ljava/lang/Object;")
-(defn add-nulls [writer amount]
- (dotimes [_ amount]
- (.visitInsn writer Opcodes/ACONST_NULL)))
-
(defn write-file [file data]
(with-open [stream (java.io.BufferedOutputStream. (java.io.FileOutputStream. file))]
(.write stream data)))
@@ -34,3 +32,98 @@
:let [_ (write-class name bytecode)
_ (load-class! loader (string/replace name #"/" "."))]]
(return nil)))
+
+(defn total-locals [expr]
+ (match expr
+ [::&a/case ?variant ?base-register ?num-registers ?branches]
+ (+ ?num-registers (reduce max 0 (map (comp total-locals second) ?branches)))
+
+ [::&a/tuple ?members]
+ (reduce max 0 (map total-locals ?members))
+
+ [::&a/variant ?tag ?members]
+ (reduce max 0 (map total-locals ?members))
+
+ [::&a/call ?fn ?args]
+ (reduce max 0 (map total-locals (cons ?fn ?args)))
+
+ [::&a/jvm-iadd ?x ?y]
+ (reduce max 0 (map total-locals (list ?x ?y)))
+
+ [::&a/jvm-isub ?x ?y]
+ (reduce max 0 (map total-locals (list ?x ?y)))
+
+ [::&a/jvm-imul ?x ?y]
+ (reduce max 0 (map total-locals (list ?x ?y)))
+
+ [::&a/jvm-idiv ?x ?y]
+ (reduce max 0 (map total-locals (list ?x ?y)))
+
+ [::&a/jvm-irem ?x ?y]
+ (reduce max 0 (map total-locals (list ?x ?y)))
+
+ [::&a/jvm-ladd ?x ?y]
+ (reduce max 0 (map total-locals (list ?x ?y)))
+
+ [::&a/jvm-lsub ?x ?y]
+ (reduce max 0 (map total-locals (list ?x ?y)))
+
+ [::&a/jvm-lmul ?x ?y]
+ (reduce max 0 (map total-locals (list ?x ?y)))
+
+ [::&a/jvm-ldiv ?x ?y]
+ (reduce max 0 (map total-locals (list ?x ?y)))
+
+ [::&a/jvm-lrem ?x ?y]
+ (reduce max 0 (map total-locals (list ?x ?y)))
+
+ [::&a/jvm-fadd ?x ?y]
+ (reduce max 0 (map total-locals (list ?x ?y)))
+
+ [::&a/jvm-fsub ?x ?y]
+ (reduce max 0 (map total-locals (list ?x ?y)))
+
+ [::&a/jvm-fmul ?x ?y]
+ (reduce max 0 (map total-locals (list ?x ?y)))
+
+ [::&a/jvm-fdiv ?x ?y]
+ (reduce max 0 (map total-locals (list ?x ?y)))
+
+ [::&a/jvm-frem ?x ?y]
+ (reduce max 0 (map total-locals (list ?x ?y)))
+
+ [::&a/jvm-dadd ?x ?y]
+ (reduce max 0 (map total-locals (list ?x ?y)))
+
+ [::&a/jvm-dsub ?x ?y]
+ (reduce max 0 (map total-locals (list ?x ?y)))
+
+ [::&a/jvm-dmul ?x ?y]
+ (reduce max 0 (map total-locals (list ?x ?y)))
+
+ [::&a/jvm-ddiv ?x ?y]
+ (reduce max 0 (map total-locals (list ?x ?y)))
+
+ [::&a/jvm-drem ?x ?y]
+ (reduce max 0 (map total-locals (list ?x ?y)))
+
+ [::&a/exec ?exprs]
+ (reduce max 0 (map total-locals ?exprs))
+
+ [::&a/jvm-new ?class ?classes ?args]
+ (reduce max 0 (map total-locals ?args))
+
+ [::&a/jvm-invokestatic ?class ?method ?classes ?args]
+ (reduce max 0 (map total-locals ?args))
+
+ [::&a/jvm-invokevirtual ?class ?method ?classes ?object ?args]
+ (reduce max 0 (map total-locals ?args))
+
+ [::&a/jvm-aastore ?array ?idx ?elem]
+ (reduce max 0 (map total-locals (list ?array ?elem)))
+
+ [::&a/jvm-aaload ?array ?idx]
+ (total-locals ?array)
+
+ _
+ 0))
diff --git a/src/lux/compiler/case.clj b/src/lux/compiler/case.clj
index 48c52123f..37fe6c61f 100644
--- a/src/lux/compiler/case.clj
+++ b/src/lux/compiler/case.clj
@@ -189,12 +189,7 @@
;; [Resources]
(defn compile-case [compile *type* ?variant ?base-register ?num-registers ?branches]
(exec [*writer* &/get-writer
- :let [$start (new Label)
- $end (new Label)
- _ (dotimes [offset ?num-registers]
- (let [idx (+ ?base-register offset)]
- (.visitLocalVariable *writer* (str &&/local-prefix idx) (&host/->java-sig [::&type/Any]) nil $start $end idx)))
- _ (.visitLabel *writer* $start)]
+ :let [$end (new Label)]
_ (compile ?variant)
:let [[mappings patterns] (process-branches ?base-register ?branches)]
_ (compile-pattern-matching *writer* compile mappings patterns $end)
diff --git a/src/lux/compiler/lambda.clj b/src/lux/compiler/lambda.clj
index 9afb2a289..5358519d9 100644
--- a/src/lux/compiler/lambda.clj
+++ b/src/lux/compiler/lambda.clj
@@ -23,170 +23,96 @@
(def ^:private clo-field-sig (&host/->type-signature "java.lang.Object"))
(def ^:private lambda-return-sig (&host/->type-signature "java.lang.Object"))
(def ^:private <init>-return "V")
-(def ^:private counter-sig "I")
-(def ^:private +datum-sig+ (&host/->type-signature "java.lang.Object"))
-(defn ^:private lambda-impl-signature [args]
- (str (reduce str "(" (repeat (count args) clo-field-sig)) ")" lambda-return-sig))
+(def ^:private lambda-impl-signature
+ (str (reduce str "(" clo-field-sig) ")"
+ lambda-return-sig))
-(defn ^:private lambda-<init>-signature [closed-over args]
- (let [num-args (count args)]
- (str "(" (reduce str "" (repeat (count closed-over) clo-field-sig))
- (if (> num-args 1)
- (reduce str counter-sig (repeat (dec num-args) clo-field-sig)))
- ")"
- <init>-return)))
+(defn ^:private lambda-<init>-signature [env]
+ (str "(" (reduce str "" (repeat (count env) clo-field-sig)) ")"
+ <init>-return))
-(defn ^:private add-lambda-<init> [class class-name closed-over args init-signature]
- (let [num-args (count args)
- num-mappings (count closed-over)]
- (doto (.visitMethod class Opcodes/ACC_PUBLIC "<init>" init-signature nil nil)
- (.visitCode)
- (.visitVarInsn Opcodes/ALOAD 0)
- (.visitMethodInsn Opcodes/INVOKESPECIAL "java/lang/Object" "<init>" "()V")
- (-> (doto (.visitVarInsn Opcodes/ALOAD 0)
- (.visitVarInsn Opcodes/ALOAD ?captured-id)
- (.visitFieldInsn Opcodes/PUTFIELD class-name captured-name clo-field-sig))
- (->> (let [captured-name (str &&/closure-prefix ?captured-id)])
- (match (:form ?captured)
- [::&analyser/captured ?closure-id ?captured-id ?source])
- (doseq [[?name ?captured] closed-over])))
- (-> (doto (.visitVarInsn Opcodes/ALOAD 0)
- (.visitVarInsn Opcodes/ILOAD 1)
- (.visitFieldInsn Opcodes/PUTFIELD class-name "_counter" counter-sig)
- (-> (doto (.visitVarInsn Opcodes/ALOAD 0)
- (.visitVarInsn Opcodes/ALOAD (+ clo_idx offset))
- (.visitFieldInsn Opcodes/PUTFIELD class-name field-name clo-field-sig))
- (->> (let [field-name (str &&/partial-prefix clo_idx)]
- (doto (.visitField class (+ Opcodes/ACC_PRIVATE Opcodes/ACC_FINAL) field-name clo-field-sig nil nil)
- (.visitEnd)))
- (dotimes [clo_idx (dec num-args)])
- (let [offset (+ 2 num-mappings)]))))
- (->> (when (> num-args 1))))
- (.visitInsn Opcodes/RETURN)
- (.visitMaxs 0 0)
- (.visitEnd))))
+(defn ^:private add-lambda-<init> [class class-name env]
+ (doto (.visitMethod class Opcodes/ACC_PUBLIC "<init>" (lambda-<init>-signature env) nil nil)
+ (.visitCode)
+ (.visitVarInsn Opcodes/ALOAD 0)
+ (.visitMethodInsn Opcodes/INVOKESPECIAL "java/lang/Object" "<init>" "()V")
+ (-> (doto (.visitVarInsn Opcodes/ALOAD 0)
+ (.visitVarInsn Opcodes/ALOAD (inc ?captured-id))
+ (.visitFieldInsn Opcodes/PUTFIELD class-name captured-name clo-field-sig))
+ (->> (let [captured-name (str &&/closure-prefix ?captured-id)])
+ (match ?captured
+ [::&a/Expression [::&a/captured _ ?captured-id ?source] _])
+ (doseq [[?name ?captured] env])))
+ (.visitInsn Opcodes/RETURN)
+ (.visitMaxs 0 0)
+ (.visitEnd)))
-(do-template [<name> <prefix>]
- (defn <name> [writer class-name vars]
- (dotimes [idx (count vars)]
- (doto writer
- (.visitVarInsn Opcodes/ALOAD 0)
- (.visitFieldInsn Opcodes/GETFIELD class-name (str <prefix> idx) clo-field-sig))))
-
- ^:private add-closure-vars &&/closure-prefix
- ^:private add-partial-vars &&/partial-prefix
- )
-
-(defn ^:private add-lambda-apply [class class-name closed-over args impl-signature init-signature]
- (let [num-args (count args)
- num-captured (dec num-args)
- default-label (new Label)
- branch-labels (for [_ (range num-captured)]
- (new Label))]
- (doto (.visitMethod class Opcodes/ACC_PUBLIC "apply" &&/apply-signature nil nil)
- (.visitCode)
- (-> (doto (.visitVarInsn Opcodes/ALOAD 0)
- (.visitFieldInsn Opcodes/GETFIELD class-name "_counter" counter-sig)
- (.visitTableSwitchInsn 0 (dec num-captured) default-label (into-array Label branch-labels))
- (-> (doto (.visitLabel branch-label)
- (.visitTypeInsn Opcodes/NEW class-name)
- (.visitInsn Opcodes/DUP)
- (add-closure-vars class-name closed-over)
- (.visitLdcInsn (int (inc current-captured)))
- (add-partial-vars class-name (take current-captured args))
- (.visitVarInsn Opcodes/ALOAD 1)
- (&&/add-nulls (- (dec num-captured) current-captured))
- (.visitMethodInsn Opcodes/INVOKESPECIAL class-name "<init>" init-signature)
- (.visitInsn Opcodes/ARETURN))
- (->> (doseq [[branch-label current-captured] (map vector branch-labels (range (count branch-labels)))])))
- (.visitLabel default-label))
- (->> (when (> num-args 1))))
- (.visitVarInsn Opcodes/ALOAD 0)
- (add-partial-vars class-name (butlast args))
- (.visitVarInsn Opcodes/ALOAD 1)
- (.visitMethodInsn Opcodes/INVOKEVIRTUAL class-name "impl" impl-signature)
- (.visitInsn Opcodes/ARETURN)
- (.visitMaxs 0 0)
- (.visitEnd))))
+(defn ^:private add-lambda-apply [class class-name env]
+ (doto (.visitMethod class Opcodes/ACC_PUBLIC "apply" &&/apply-signature nil nil)
+ (.visitCode)
+ (.visitVarInsn Opcodes/ALOAD 0)
+ (.visitVarInsn Opcodes/ALOAD 1)
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL class-name "impl" lambda-impl-signature)
+ (.visitInsn Opcodes/ARETURN)
+ (.visitMaxs 0 0)
+ (.visitEnd)))
(defn ^:private add-lambda-impl [class compile impl-signature impl-body]
(&/with-writer (doto (.visitMethod class Opcodes/ACC_PUBLIC "impl" impl-signature nil nil)
(.visitCode))
- (exec [;; :let [_ (prn 'add-lambda-impl/_0)]
- *writer* &/get-writer
- ;; :let [_ (prn 'add-lambda-impl/_1 *writer*)]
+ (exec [*writer* &/get-writer
+ :let [num-locals (&&/total-locals impl-body)
+ $start (new Label)
+ $end (new Label)
+ _ (doto *writer*
+ (-> (.visitLocalVariable (str &&/local-prefix idx) (&host/->java-sig [::&type/Any]) nil $start $end (+ 2 idx))
+ (->> (dotimes [idx num-locals])))
+ (.visitLabel $start))]
ret (compile impl-body)
- ;; :let [_ (prn 'add-lambda-impl/_2 ret)]
:let [_ (doto *writer*
+ (.visitLabel $end)
(.visitInsn Opcodes/ARETURN)
(.visitMaxs 0 0)
- (.visitEnd))]
- ;; :let [_ (prn 'add-lambda-impl/_3)]
- ]
+ (.visitEnd))]]
(return ret))))
-(defn ^:private instance-closure [compile lambda-class closed-over args init-signature]
+(defn ^:private instance-closure [compile lambda-class closed-over init-signature]
(exec [*writer* &/get-writer
:let [_ (doto *writer*
(.visitTypeInsn Opcodes/NEW lambda-class)
(.visitInsn Opcodes/DUP))]
_ (->> closed-over
- (sort #(< (-> %1 second :form (nth 2))
- (-> %2 second :form (nth 2))))
+ (sort #(match [%1 %2]
+ [[::&a/Expression [::&a/captured _ ?cid1 _] _]
+ [::&a/Expression [::&a/captured _ ?cid2 _] _]]
+ (< ?cid1 ?cid2)))
(map-m (fn [[?name ?captured]]
- (match (:form ?captured)
- [::&analyser/captured ?closure-id ?captured-id ?source]
+ (match ?captured
+ [::&a/Expression [::&a/captured _ ?captured-id ?source] _]
(compile ?source)))))
- :let [num-args (count args)
- _ (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))]]
+ :let [_ (.visitMethodInsn *writer* Opcodes/INVOKESPECIAL lambda-class "<init>" init-signature)]]
(return nil)))
-(defn ^:private add-lambda-<clinit> [class class-name args <init>-sig]
- (let [num-args (count args)]
- (doto (.visitMethod class Opcodes/ACC_PUBLIC "<clinit>" "()V" nil nil)
- (.visitCode)
- (.visitTypeInsn Opcodes/NEW class-name)
- (.visitInsn Opcodes/DUP)
- (-> (doto (.visitInsn Opcodes/ICONST_0)
- (&&/add-nulls (dec num-args)))
- (->> (when (> num-args 1))))
- (.visitMethodInsn Opcodes/INVOKESPECIAL class-name "<init>" <init>-sig)
- (.visitFieldInsn Opcodes/PUTSTATIC class-name "_datum" +datum-sig+)
- (.visitInsn Opcodes/RETURN)
- (.visitMaxs 0 0)
- (.visitEnd))))
-
-;; [Resources]
-(defn compile-lambda [compile *type* ?scope ?closure ?args ?body with-datum? instance?]
- ;; (prn 'compile-lambda ?scope ?closure ?args ?body)
+;; [Exports]
+(defn compile-lambda [compile ?scope ?env ?arg ?body]
+ (prn 'compile-lambda ?scope ?arg)
(exec [:let [lambda-class (&host/location ?scope)
- impl-signature (lambda-impl-signature ?args)
- <init>-sig (lambda-<init>-signature ?closure ?args)
=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
(.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_SUPER)
lambda-class nil "java/lang/Object" (into-array [(&host/->class &host/function-class)]))
(-> (doto (.visitField (+ Opcodes/ACC_PRIVATE Opcodes/ACC_FINAL) captured-name clo-field-sig nil nil)
(.visitEnd))
(->> (let [captured-name (str &&/closure-prefix ?captured-id)])
- (match (:form ?captured)
- [::&analyser/captured ?closure-id ?captured-id ?source])
- (doseq [[?name ?captured] ?closure])))
- (-> (doto (.visitField (+ Opcodes/ACC_PRIVATE Opcodes/ACC_FINAL) "_counter" counter-sig nil nil)
- (.visitEnd))
- (->> (when (> (count ?args) 1))))
- (-> (doto (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "_datum" +datum-sig+ nil nil)
- (add-lambda-<clinit> lambda-class ?args <init>-sig))
- (when with-datum?))
- (add-lambda-apply lambda-class ?closure ?args impl-signature <init>-sig)
- (add-lambda-<init> lambda-class ?closure ?args <init>-sig)
+ (match ?captured
+ [::&a/Expression [::&a/captured _ ?captured-id ?source] _])
+ (doseq [[?name ?captured] ?env
+ ;; :let [_ (prn '?captured ?captured)]
+ ])))
+ (add-lambda-apply lambda-class ?env)
+ (add-lambda-<init> lambda-class ?env)
)]
- _ (add-lambda-impl =class compile impl-signature ?body)
+ _ (add-lambda-impl =class compile lambda-impl-signature ?body)
:let [_ (.visitEnd =class)]
_ (&&/save-class! lambda-class (.toByteArray =class))]
- (if instance?
- (instance-closure compile lambda-class ?closure ?args <init>-sig)
- (return nil))))
+ (instance-closure compile lambda-class ?env (lambda-<init>-signature ?env))))
diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj
index 72aff9798..f85d2f7a5 100644
--- a/src/lux/compiler/lux.clj
+++ b/src/lux/compiler/lux.clj
@@ -21,34 +21,7 @@
ClassWriter
MethodVisitor)))
-;; [Utils]
-(defn ^:private compile-field [compile ?name body]
- (exec [*writer* &/get-writer
- 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 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)
- current-class nil "java/lang/Object" (into-array [(&host/->class &host/function-class)]))
- (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_datum" datum-sig nil nil)
- (doto (.visitEnd))))]
- _ (&/with-writer (.visitMethod =class Opcodes/ACC_PUBLIC "<clinit>" "()V" nil nil)
- (exec [*writer* &/get-writer
- :let [_ (.visitCode *writer*)]
- _ (compile body)
- :let [_ (doto *writer*
- (.visitFieldInsn Opcodes/PUTSTATIC current-class "_datum" datum-sig)
- (.visitInsn Opcodes/RETURN)
- (.visitMaxs 0 0)
- (.visitEnd))]]
- (return nil)))
- :let [_ (.visitEnd *writer*)]
- _ (&&/save-class! current-class (.toByteArray =class))]
- (return nil)))
-
-;; [Resources]
+;; [Exports]
(let [+class+ (&host/->class "java.lang.Boolean")
+sig+ (&host/->type-signature "java.lang.Boolean")]
(defn compile-bool [compile *type* ?value]
@@ -114,11 +87,12 @@
(return nil)))
(defn compile-captured [compile *type* ?scope ?captured-id ?source]
+ (prn 'compile-captured ?scope ?captured-id)
(exec [*writer* &/get-writer
:let [_ (doto *writer*
(.visitVarInsn Opcodes/ALOAD 0)
(.visitFieldInsn Opcodes/GETFIELD
- (normalize-ident ?scope)
+ (&host/location ?scope)
(str &&/closure-prefix ?captured-id)
"Ljava/lang/Object;"))]]
(return nil)))
@@ -138,41 +112,28 @@
?args)]
(return nil)))
-(defn compile-def [compile name value]
- (exec [value-type (&a/expr-type value)]
- (match value
- [::&a/Expression ?form _]
- (match ?form
- [::&a/lambda ?scope ?captured ?args ?body]
- (&&lambda/compile-lambda compile value-type ?scope ?captured ?args ?body true false)
-
- _
- (compile-field compile name value))
-
- _
- (fail "Can only define expressions."))))
-
-(defn compile-self-call [compile ?scope ?assumed-args]
- ;; (prn 'compile-self-call ?scope ?assumed-args)
+(defn compile-def [compile ?name ?body]
(exec [*writer* &/get-writer
- :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)]]
- (return ret)))
- ?assumed-args)]
+ 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 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)
+ current-class nil "java/lang/Object" (into-array [(&host/->class &host/function-class)]))
+ (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_datum" datum-sig nil nil)
+ (doto (.visitEnd))))]
+ _ (&/with-writer (.visitMethod =class Opcodes/ACC_PUBLIC "<clinit>" "()V" nil nil)
+ (exec [*writer* &/get-writer
+ :let [_ (.visitCode *writer*)]
+ _ (compile ?body)
+ :let [_ (doto *writer*
+ (.visitFieldInsn Opcodes/PUTSTATIC current-class "_datum" datum-sig)
+ (.visitInsn Opcodes/RETURN)
+ (.visitMaxs 0 0)
+ (.visitEnd))]]
+ (return nil)))
+ :let [_ (.visitEnd *writer*)]
+ _ (&&/save-class! current-class (.toByteArray =class))]
(return nil)))
diff --git a/src/lux/macro.clj b/src/lux/macro.clj
index e7c54d8ac..7f1e7116b 100644
--- a/src/lux/macro.clj
+++ b/src/lux/macro.clj
@@ -60,9 +60,8 @@
;; [Resources]
(defn expand [loader macro-class tokens]
(let [output (-> (.loadClass loader macro-class)
- .getDeclaredConstructors
- first
- (.newInstance (to-array [(int 0) nil]))
+ (.getField "_datum")
+ (.get nil)
(.apply (->lux+ ->lux loader tokens))
(.apply nil))]
[(->clojure+ ->clojure (aget output 0))
diff --git a/src/lux/optimizer.clj b/src/lux/optimizer.clj
index be6df920f..0daabe2b5 100644
--- a/src/lux/optimizer.clj
+++ b/src/lux/optimizer.clj
@@ -10,6 +10,7 @@
;; Mutability for performance: do escape analysis to know when data-structures can be mutated in-place without anybody noticing.
;; Avoid (un)boxing: Analyser movement of primitive values to/from functions to known when (un)boxing can be avoided.
;; Pre-compute constant expressions: Find function calls for which all arguments are known at compile-time and pre-calculate everything prior to compilation.
+;; Convert pattern-matching on booleans into regular if-then-else structures
;; [Exports]
(def optimize &analyser/analyse)