From ae5c933a5208c51fe30d0b9dc976690ee8bc138a Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 1 Mar 2015 21:08:57 -0400 Subject: Code compiles again! (although, I had to employ a hack for "fold", as function self-calls are broken). Also fixed several small bugs, including the one that caused ".apply" to never make progress (always returned a function with count 0). Also fixed an issue with scopes that caused class-names to be generated improperly. --- source/lux.lux | 213 +++++++++++++++++++------------------------- src/lux/analyser.clj | 15 ++-- src/lux/analyser/env.clj | 9 +- src/lux/analyser/host.clj | 44 +++++---- src/lux/analyser/lambda.clj | 200 ++++++++++++++++++++++++++++++++++------- src/lux/analyser/lux.clj | 28 +++--- src/lux/compiler.clj | 7 +- src/lux/compiler/host.clj | 1 + src/lux/compiler/lambda.clj | 2 +- src/lux/compiler/lux.clj | 25 ++++-- src/lux/host.clj | 44 ++++----- src/lux/macro.clj | 7 +- 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 [ ] - (defn [analyse ?x ?y] - (exec [:let [=type [::&type/Data ]] - [=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 [ =x =y] =type])))) + (let [elem-type [::&type/Data ]] + (defn [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 [ =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-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 [ ] (defn [target field] - (if-let [type* (first (for [=field (.getFields target) - :when (and (= target (.getDeclaringClass =field)) - (= field (.getName =field)) - (= (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)) + (= (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 [ ] (defn [target method-name args] - (if-let [method (first (for [=method (.getMethods target) - :when (and (= target (.getDeclaringClass =method)) - (= method-name (.getName =method)) - (= (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 ' '=method =method (mapv #(.getName %) (.getParameterTypes =method)))] + :when (and (= target (.getDeclaringClass =method)) + (= method-name (.getName =method)) + (= (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)) -- cgit v1.2.3