diff options
| author | Eduardo Julian | 2015-03-01 21:08:57 -0400 | 
|---|---|---|
| committer | Eduardo Julian | 2015-03-01 21:08:57 -0400 | 
| commit | ae5c933a5208c51fe30d0b9dc976690ee8bc138a (patch) | |
| tree | 76c7a03ea3807526c3d3a1a76ac8a2aebea55c1e /src | |
| parent | f5b2f04fec382da0d164f772ed65ae058e66d8e2 (diff) | |
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.
Diffstat (limited to '')
| -rw-r--r-- | src/lux/analyser.clj | 15 | ||||
| -rw-r--r-- | src/lux/analyser/env.clj | 9 | ||||
| -rw-r--r-- | src/lux/analyser/host.clj | 44 | ||||
| -rw-r--r-- | src/lux/analyser/lambda.clj | 200 | ||||
| -rw-r--r-- | src/lux/analyser/lux.clj | 28 | ||||
| -rw-r--r-- | src/lux/compiler.clj | 7 | ||||
| -rw-r--r-- | src/lux/compiler/host.clj | 1 | ||||
| -rw-r--r-- | src/lux/compiler/lambda.clj | 2 | ||||
| -rw-r--r-- | src/lux/compiler/lux.clj | 25 | ||||
| -rw-r--r-- | src/lux/host.clj | 44 | ||||
| -rw-r--r-- | src/lux/macro.clj | 7 | 
11 files changed, 272 insertions, 110 deletions
| 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)) | 
