diff options
| -rw-r--r-- | src/lux/analyser.clj | 368 | ||||
| -rw-r--r-- | src/lux/compiler.clj | 33 | ||||
| -rw-r--r-- | src/lux/parser.clj | 246 | ||||
| -rw-r--r-- | test2.lux | 53 |
4 files changed, 282 insertions, 418 deletions
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index 1bac77dce..eb6ca7fdd 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -216,40 +216,31 @@ (defn ^:private resolve [ident] (fn [state] - (if-let [[_ ?alias ?binding] (re-find #"^(.*)/(.*)$" ident)] - (let [?module (get-in state [:deps ?alias])] - ;; (prn 'resolve ?module ?alias ?binding) - [::&util/ok [state (annotated [::global ?module ?binding] ::&type/nothing)]]) - (let [;; _ (prn 'resolve/_1 ident) - [inner outer] (split-with #(nil? (get-in % [:mappings ident])) (:env state)) - ;; _ (prn ident '[inner outer] [inner outer]) - ;; _ (prn 'resolve/_2 '[inner outer] [inner outer]) - ] - (cond (empty? inner) - [::&util/ok [state (-> state :env first :mappings (get ident))]] - - (empty? outer) - (if-let [global|import (or (get-in state [:defs-env ident]) - (get-in state [:imports ident]))] - (do ;; (prn 'resolve/_3 'global|import global|import) - [::&util/ok [state global|import]]) - [::&util/failure (str "Unresolved identifier: " ident)]) - - :else - (let [[=local inner*] (reduce (fn [[register new-inner] [frame scope]] - (let [[register* frame*] (close-over scope ident register frame)] - [register* (cons frame* new-inner)])) - [(-> outer first :mappings (get ident)) '()] - (map vector - (reverse inner) - (->> (get-in state [:lambda-scope 0]) - (iterate pop) - (take (count inner)) - reverse))) - ;; _ (prn 'resolve/_4 '[=local inner*] =local inner*) - ] - [::&util/ok [(assoc state :env (concat inner* outer)) =local]]))) - ))) + (or (if-let [[_ ?alias ?binding] (re-find #"^(.*)/(.*)$" ident)] + (if-let [?module (get-in state [:deps ?alias])] + [::&util/ok [state (annotated [::global ?module ?binding] ::&type/nothing)]])) + (let [[inner outer] (split-with #(nil? (get-in % [:mappings ident])) (:env state))] + (cond (empty? inner) + [::&util/ok [state (-> state :env first :mappings (get ident))]] + + (empty? outer) + (if-let [global|import (or (get-in state [:defs-env ident]) + (get-in state [:imports ident]))] + [::&util/ok [state global|import]] + [::&util/failure (str "Unresolved identifier: " ident)]) + + :else + (let [[=local inner*] (reduce (fn [[register new-inner] [frame scope]] + (let [[register* frame*] (close-over scope ident register frame)] + [register* (cons frame* new-inner)])) + [(-> outer first :mappings (get ident)) '()] + (map vector + (reverse inner) + (->> (get-in state [:lambda-scope 0]) + (iterate pop) + (take (count inner)) + reverse)))] + [::&util/ok [(assoc state :env (concat inner* outer)) =local]])))))) (defmacro ^:private defanalyser [name match return] `(def ~name @@ -272,7 +263,7 @@ [::&util/ok [(assoc ?state :forms old-forms) ?value]] [::&util/failure ?message] - (do (prn 'analyse-form* ?message) + (do ;; (prn 'analyse-form* ?message) [::&util/failure ?message]))))) (do-template [<name> <tag> <class>] @@ -288,12 +279,17 @@ ) (defanalyser analyse-variant - [::&parser/variant ?tag ?data] - (exec [;; :let [_ (prn 'analyse-variant [?tag ?value])] - =data (map-m analyse-form* ?data) - ;; :let [_ (prn '=value =value)] - ] - (return (annotated [::variant ?tag =data] [::&type/variant ?tag (map :type =data)])))) + ?token + (match ?token + [::&parser/tag ?tag] + (return (annotated [::variant ?tag '()] [::&type/variant ?tag '()])) + + [::&parser/form ([[::&parser/tag ?tag] & ?data] :seq)] + (exec [=data (map-m analyse-form* ?data)] + (return (annotated [::variant ?tag =data] [::&type/variant ?tag (map :type =data)]))) + + _ + (fail ""))) (defanalyser analyse-tuple [::&parser/tuple ?elems] @@ -389,16 +385,16 @@ (fail (str "Field does not exist: " target field)))) (defn lookup-virtual-method [target method-name args] - (prn 'lookup-virtual-method target method-name args) + ;; (prn 'lookup-virtual-method target method-name args) (if-let [method (first (for [=method (.getMethods target) :when (and (= target (.getDeclaringClass =method)) (= method-name (.getName =method)) (not (java.lang.reflect.Modifier/isStatic (.getModifiers =method))))] =method))] - (do (prn 'lookup-virtual-method 'method method) + (do ;; (prn 'lookup-virtual-method 'method method) (exec [=method (&type/method->type method)] (&type/return-type =method))) - (do (prn 'lookup-virtual-method (str "Virtual method does not exist: " target method-name)) + (do ;; (prn 'lookup-virtual-method (str "Virtual method does not exist: " target method-name)) (fail (str "Virtual method does not exist: " target method-name))))) (defn full-class-name [class] @@ -422,17 +418,19 @@ (fail "Unknown class.")))]))) (defanalyser analyse-jvm-getstatic - [::&parser/jvm-getstatic ?class ?field] + [::&parser/form ([[::&parser/ident "jvm/getstatic"] [::&parser/ident ?class] [::&parser/ident ?field]] :seq)] (exec [=class (full-class-name ?class) =type (lookup-static-field (Class/forName =class) ?field)] (return (annotated [::jvm-getstatic =class ?field] =type)))) (defanalyser analyse-jvm-invokevirtual - [::&parser/jvm-invokevirtual ?class ?method ?classes ?object ?args] + [::&parser/form ([[::&parser/ident "jvm/invokevirtual"] [::&parser/ident ?class] [::&parser/text ?method] [::&parser/tuple ?classes] ?object [::&parser/tuple ?args]] :seq)] (exec [=class (full-class-name ?class) - =classes (map-m full-class-name ?classes) + =classes (map-m #(exec [class* (extract-ident %)] + (full-class-name class*)) + ?classes) =return (lookup-virtual-method (Class/forName =class) ?method (map #(Class/forName %) =classes)) - :let [_ (prn 'analyse-jvm-invokevirtual '=return =return)] + ;; :let [_ (prn 'analyse-jvm-invokevirtual '=return =return)] ;; =return =return =object (analyse-form* ?object) =args (map-m analyse-form* ?args)] @@ -478,6 +476,10 @@ (defn ->token [x] ;; (prn '->token x) (match x + [::&parser/tag ?tag] + (doto (.newInstance (.loadClass loader "test2.Variant1")) + (-> .-tag (set! "Tag")) + (-> .-_1 (set! ?tag))) [::&parser/text ?text] (doto (.newInstance (.loadClass loader "test2.Variant1")) (-> .-tag (set! "Text")) @@ -486,10 +488,10 @@ (doto (.newInstance (.loadClass loader "test2.Variant1")) (-> .-tag (set! "Ident")) (-> .-_1 (set! ?ident))) - [::&parser/fn-call ?fn ?args] + [::&parser/form ?elems] (doto (.newInstance (.loadClass loader "test2.Variant1")) (-> .-tag (set! "Form")) - (-> .-_1 (set! (->tokens (cons ?fn ?args))))) + (-> .-_1 (set! (->tokens ?elems)))) )) (defn ->tokens [xs] @@ -506,11 +508,10 @@ (defn ->clojure-token [x] ;; (prn '->clojure-token x (.-tag x)) (case (.-tag x) - "Text" [::&parser/text (-> x .-_1 (doto (-> string? assert)))] - "Ident" [::&parser/ident (-> x .-_1 (doto (-> string? assert)))] - "Form" (let [[?fn & ?args] (-> x .-_1 tokens->clojure)] - [::&parser/fn-call ?fn ?args]) - "Quote" [::&parser/quote (-> x .-_1 ->clojure-token)])) + "Text" [::&parser/text (-> x .-_1)] + "Ident" [::&parser/ident (-> x .-_1)] + "Tag" [::&parser/tag (-> x .-_1)] + "Form" [::&parser/form (-> x .-_1 tokens->clojure)])) (defn tokens->clojure [xs] ;; (prn 'tokens->clojure xs (.-tag xs)) @@ -520,15 +521,22 @@ (tokens->clojure (.-_2 xs))) )) -(defanalyser analyse-fn-call - [::&parser/fn-call ?fn ?args] - (exec [=fn (analyse-form* ?fn)] +(defanalyser analyse-call + [::&parser/form ([?fn & ?args] :seq)] + (exec [=fn (analyse-form* ?fn) + :let [_ (prn 'analyse-call/=fn =fn)]] (match (:form =fn) [::global-fn ?module ?name] (exec [macro? (is-macro? ?fn) - scoped? (in-scope? ?fn)] + scoped? (in-scope? ?fn) + :let [_ (prn 'analyse-call [:global-fn ?module ?name] macro? scoped?)]] (if (and macro? (not scoped?)) - (let [macro-class (str ?module "$" (normalize-ident ?name))] + (let [macro-class (str ?module "$" (normalize-ident ?name)) + transformed (-> (.loadClass loader macro-class) + .newInstance + (.apply (->tokens ?args)) + ->clojure-token) + _ (prn 'analyse-call/transformed transformed)] (-> (.loadClass loader macro-class) .newInstance (.apply (->tokens ?args)) @@ -552,7 +560,7 @@ )) (defanalyser analyse-if - [::&parser/if ?test ?then ?else] + [::&parser/form ([[::&parser/ident "if"] ?test ?then ?else] :seq)] (exec [=test (analyse-form* ?test) ;; :let [_ (prn '=test =test)] ;; :let [_ (prn 'PRE '?then ?then)] @@ -564,7 +572,7 @@ (return (annotated [::if =test =then =else] ::&type/nothing)))) (defanalyser analyse-do - [::&parser/do ?exprs] + [::&parser/form ([[::&parser/ident "do"] & ?exprs] :seq)] (exec [=exprs (map-m analyse-form* ?exprs)] (return (annotated [::do =exprs] (-> =exprs last :type))))) @@ -642,14 +650,26 @@ (clojure.core.match/match pattern [::&parser/ident ?name] (list ?name) - - [::&parser/variant ?tag ?members] + + [::&parser/tag _] + '() + + [::&parser/form ([[::&parser/tag _] & ?members] :seq)] (mapcat get-vars ?members) + [::&parser/variant ?tag ?members] + (mapcat get-vars ?members) + [::&parser/text ?text] '())) ->instructions (fn ->instructions [locals pattern] (clojure.core.match/match pattern + [::&parser/tag ?tag] + [::pm-variant ?tag '()] + + [::&parser/form ([[::&parser/tag ?tag] & ?members] :seq)] + [::pm-variant ?tag (map (partial ->instructions locals) ?members)] + [::&parser/variant ?tag ?members] [::pm-variant ?tag (map (partial ->instructions locals) ?members)] @@ -663,14 +683,14 @@ (let [;; Step 1: Get all vars vars+body (for [branch branches] (clojure.core.match/match branch - [::&parser/case-branch ?pattern ?body] + [::case-branch ?pattern ?body] [(get-vars ?pattern) ?body])) max-registers (reduce max 0 (map (comp count first) vars+body)) ;; Step 2: Analyse bodies [_ branch-mappings branches*] (reduce (fn [[$link links branches*] branch] (clojure.core.match/match branch - [::&parser/case-branch ?pattern ?body] - [(inc $link) (assoc links $link ?body) (conj branches* [::&parser/case-branch ?pattern $link])])) + [::case-branch ?pattern ?body] + [(inc $link) (assoc links $link ?body) (conj branches* [::case-branch ?pattern $link])])) [0 {} []] branches) ;; Step 4: Pattens -> Instructions @@ -679,7 +699,7 @@ [(inc $local) (assoc =locals $var [::local $scope $local])]) [$base {}] branch-vars)]] (clojure.core.match/match branch - [::&parser/case-branch ?pattern ?body] + [::case-branch ?pattern ?body] [(->instructions locals ?pattern) ?body])) ;; _ (prn branches**) ;; Step 5: Re-structure branching @@ -687,27 +707,32 @@ [max-registers branch-mappings (generate-branches branches**)]))) (defanalyser analyse-case - [::&parser/case ?variant ?branches] + [::&parser/form ([[::&parser/ident "case"] ?variant & ?branches] :seq)] (exec [=variant (analyse-form* ?variant) ;; :let [_ (prn 'analyse-case '=variant =variant)] $scope scope-id ;; :let [_ (prn 'analyse-case '$scope $scope)] $base next-local-idx ;; :let [_ (prn 'analyse-case '$base $base)] - [registers mappings tree] (exec [=branches (map-m (fn [?branch] - (match ?branch - [::&parser/case-branch [::&parser/ident ?name] ?body] + [registers mappings tree] (exec [=branches (map-m (fn [[?pattern ?body]] + ;; (prn '?branch ?branch) + (match ?pattern + [::&parser/ident ?name] (exec [=body (with-locals {?name (annotated [::local $scope $base] [::&type/object "java.lang.Object" []])} (analyse-form* ?body))] - (return [::&parser/case-branch [::&parser/ident ?name] =body])) + (return [::case-branch [::&parser/ident ?name] =body])) - [::&parser/case-branch [::&parser/variant ?tag ?members] ?body] + [::&parser/tag ?tag] + (exec [=body (analyse-form* ?body)] + (return [::case-branch [::&parser/variant ?tag '()] =body])) + + [::&parser/form ([[::&parser/tag ?tag] & ?members] :seq)] (exec [[_ locals+] (reduce-m (fn member-fold [[$local locals-map] ?member] (match ?member [::&parser/ident ?name] (return [(inc $local) (assoc locals-map ?name (annotated [::local $scope $local] [::&type/object "java.lang.Object" []]))]) - [::&parser/variant ?subtag ?submembers] + [::&parser/form ([[::&parser/tag ?subtag] & ?submembers] :seq)] (reduce-m member-fold [$local locals-map] ?submembers) _ @@ -720,15 +745,16 @@ (analyse-form* ?body)) ;; :let [_ (prn 'analyse-case '=body =body)] ] - (return [::&parser/case-branch [::&parser/variant ?tag ?members] =body])))) - ?branches)] + (return [::case-branch [::&parser/variant ?tag ?members] =body])) + )) + (partition 2 ?branches))] (return (->decision-tree $scope $base =branches))) ;; :let [_ (prn 'analyse-case '[registers mappings tree] [registers mappings tree])] ] (return (annotated [::case (dec $base) =variant registers mappings tree] ::&type/nothing)))) (defanalyser analyse-let - [::&parser/let ?label ?value ?body] + [::&parser/form ([[::&parser/ident "let"] [::&parser/ident ?label] ?value ?body] :seq)] (exec [=value (analyse-form* ?value) idx next-local-idx =body (with-local ?label =value @@ -736,25 +762,49 @@ (return (annotated [::let idx ?label =value =body] (:type =body))))) (defanalyser analyse-defclass - [::&parser/defclass ?name ?super-class ?fields] - (let [=members {:fields (into {} (for [[class field] ?fields] - [field {:access ::public - :type class}]))} - =class [::class ?name =members]] - (exec [name module-name] - (return (annotated [::defclass [name ?name] ?super-class =members] ::&type/nothing))))) + [::&parser/form ([[::&parser/ident "jvm/defclass"] [::&parser/ident ?name] [::&parser/ident ?super-class] [::&parser/tuple ?fields]] :seq)] + (exec [;; :let [_ (prn 'analyse-defclass/?fields ?fields)] + ?fields (map-m (fn [?field] + (match ?field + [::&parser/tuple ([[::&parser/ident ?class] [::&parser/ident ?field-name]] :seq)] + (return [?class ?field-name]) + + _ + (fail ""))) + ?fields) + :let [;; _ (prn 'analyse-defclass/?fields ?fields) + =members {:fields (into {} (for [[class field] ?fields] + [field {:access ::public + :type class}]))}] + name module-name] + (return (annotated [::defclass [name ?name] ?super-class =members] ::&type/nothing)))) (defanalyser analyse-definterface - [::&parser/definterface ?name ?members] - (let [=members {:methods (into {} (for [[method [inputs output]] ?members] - [method {:access ::public - :type [inputs output]}]))} - =interface [::interface ?name =members]] - (exec [name module-name] - (return (annotated [::definterface [name ?name] =members] ::&type/nothing))))) + [::&parser/form ([[::&parser/ident "jvm/definterface"] [::&parser/ident ?name] & ?members] :seq)] + (exec [;; :let [_ (prn 'analyse-definterface/?members ?members)] + ?members (map-m #(match % + [::&parser/form ([[::&parser/ident ":"] [::&parser/ident ?member-name] + [::&parser/form ([[::&parser/ident "->"] [::&parser/tuple ?inputs] [::&parser/ident ?output]] :seq)]] + :seq)] + (exec [;; :let [_ (prn '[?member-name ?inputs ?output] [?member-name ?inputs ?output])] + ?inputs (map-m extract-ident ?inputs) + ;; :let [_ (prn '[?member-name ?inputs ?output] [?member-name ?inputs ?output])] + ] + (return [?member-name [?inputs ?output]])) + + _ + (fail "")) + ?members) + :let [;; _ (prn '?members ?members) + =members {:methods (into {} (for [[method [inputs output]] ?members] + [method {:access ::public + :type [inputs output]}]))} + =interface [::interface ?name =members]] + name module-name] + (return (annotated [::definterface [name ?name] =members] ::&type/nothing)))) (defanalyser analyse-def - [::&parser/def ?usage ?value] + [::&parser/form ([[::&parser/ident "def"] ?usage ?value] :seq)] (match ?usage [::&parser/ident ?name] (exec [=value (with-scope ?name @@ -764,35 +814,33 @@ :type (:type =value)})] (return (annotated [::def ?name =value] ::&type/nothing))) - [::&parser/fn-call [::&parser/ident ?name] ?args] - (let [args (for [a ?args] - (match a - [::&parser/ident ?ident] - ?ident))] - (exec [[=function =args =return] (within :types (&type/fresh-function (count args))) - ;; :let [_ (prn '[=function =args =return] [=function =args =return])] - ;; :let [env (-> {} - ;; (assoc ?name =function) - ;; (into (map vector args =args))) - ;; _ (prn 'env env)] - =value (with-scope ?name - (with-scoped-name ?name =function - (reduce (fn [inner [label type]] - (with-local label type inner)) - (analyse-form* ?value) - (reverse (map vector args =args))))) - ;; :let [_ (prn '=value =value)] - =function (within :types (exec [_ (&type/solve =return (:type =value))] - (&type/clean =function))) - ;; :let [_ (prn '=function =function)] - _ (define-fn ?name {:mode ::function - :access ::public - :type =function})] - (return (annotated [::def [?name args] =value] ::&type/nothing)))) + [::&parser/form ([[::&parser/ident ?name] & ?args] :seq)] + (exec [args (map-m extract-ident ?args) + ;; :let [_ (prn 'analyse-def/args args)] + [=function =args =return] (within :types (&type/fresh-function (count args))) + ;; :let [_ (prn '[=function =args =return] [=function =args =return])] + ;; :let [env (-> {} + ;; (assoc ?name =function) + ;; (into (map vector args =args))) + ;; _ (prn 'env env)] + =value (with-scope ?name + (with-scoped-name ?name =function + (reduce (fn [inner [label type]] + (with-local label type inner)) + (analyse-form* ?value) + (reverse (map vector args =args))))) + ;; :let [_ (prn '=value =value)] + =function (within :types (exec [_ (&type/solve =return (:type =value))] + (&type/clean =function))) + ;; :let [_ (prn '=function =function)] + _ (define-fn ?name {:mode ::function + :access ::public + :type =function})] + (return (annotated [::def [?name args] =value] ::&type/nothing))) )) (defanalyser analyse-defmacro - [::&parser/defmacro [::&parser/fn-call [::&parser/ident ?name] ([[::&parser/ident ?tokens]] :seq)] ?value] + [::&parser/form ([[::&parser/ident "defmacro"] [::&parser/form ([[::&parser/ident ?name] [::&parser/ident ?tokens]] :seq)] ?value] :seq)] (exec [[=function =tokens =return] (within :types (&type/fresh-function 1)) =value (with-scope ?name (with-scoped-name ?name =function @@ -806,52 +854,38 @@ (return (annotated [::def [?name (list ?tokens)] =value] ::&type/nothing)))) (defanalyser analyse-lambda - [::&parser/lambda ?args ?body] - (exec [;; :let [_ (prn 'analyse-lambda ?args ?body)] + [::&parser/form ([[::&parser/ident "lambda"] [::&parser/tuple ?args] ?body] :seq)] + (exec [?args (map-m extract-ident ?args) [=function =args =return] (within :types (&type/fresh-function (count ?args))) - ;; :let [_ (prn '[=function =args =return] [=function =args =return])] - ;; :let [_ (prn 'PRE/?body ?body)] - ;; _env (fn [state] [::&util/ok [state (:env state)]]) - ;; :let [_ (prn 'analyse-lambda _env)] [=scope =frame =body] (with-fresh-env [?args =args] (analyse-form* ?body)) - ;; :let [_ (prn '=body =body)] =function (within :types (exec [_ (&type/solve =return (:type =body))] - (&type/clean =function))) - ;; :let [_ (prn '=function =function)] - ] + (&type/clean =function)))] (return (annotated [::lambda =scope =frame ?args =body] =function)))) (defanalyser analyse-import - [::&parser/import ?class] + [::&parser/form ([[::&parser/ident "import"] [::&parser/ident ?class]] :seq)] (exec [_ (import-class ?class (last (string/split ?class #"\.")))] (return (annotated [::import ?class] ::&type/nothing)))) (defanalyser analyse-use - [::&parser/use ?file ?alias] - (let [;; _ (prn `[use ~?file ~?alias]) - module-name (re-find #"[^/]+$" ?file) - ;; _ (prn 'module-name module-name) - ] + [::&parser/form ([[::&parser/ident "use"] [::&parser/text ?file] [::&parser/ident "as"] [::&parser/ident ?alias]] :seq)] + (let [module-name (re-find #"[^/]+$" ?file)] (exec [_ (use-module module-name ?alias)] (return (annotated [::use ?file ?alias] ::&type/nothing))))) -(defanalyser analyse-quote - [::&parser/quote ?quoted] - (return (annotated [::quote ?quoted] ::&type/nothing))) - -(do-template [<name> <input-tag> <output-tag>] +(do-template [<name> <ident> <output-tag>] (defanalyser <name> - [<input-tag> ?x ?y] + [::&parser/form ([[::&parser/ident <ident>] ?x ?y] :seq)] (exec [=x (analyse-form* ?x) =y (analyse-form* ?y)] (return (annotated [<output-tag> =x =y] [::&type/object "java.lang.Integer" []])))) - ^:private analyse-jvm-i+ ::&parser/jvm-i+ ::jvm-i+ - ^:private analyse-jvm-i- ::&parser/jvm-i- ::jvm-i- - ^:private analyse-jvm-i* ::&parser/jvm-i* ::jvm-i* - ^:private analyse-jvm-idiv ::&parser/jvm-idiv ::jvm-idiv - ^:private analyse-jvm-irem ::&parser/jvm-irem ::jvm-irem + ^:private analyse-jvm-i+ "jvm/i+" ::jvm-i+ + ^:private analyse-jvm-i- "jvm/i-" ::jvm-i- + ^:private analyse-jvm-i* "jvm/i*" ::jvm-i* + ^:private analyse-jvm-idiv "jvm/i/" ::jvm-idiv + ^:private analyse-jvm-irem "jvm/irem" ::jvm-irem ) (def analyse-form @@ -860,46 +894,26 @@ analyse-real analyse-char analyse-text - analyse-variant - analyse-tuple - analyse-lambda analyse-ident - analyse-fn-call - analyse-if + analyse-tuple + analyse-variant + analyse-call analyse-do - analyse-case + analyse-if analyse-let - analyse-defclass - analyse-definterface + analyse-case + analyse-lambda analyse-def analyse-defmacro - analyse-import + analyse-defclass + analyse-definterface analyse-use - analyse-quote + analyse-import analyse-jvm-i+ analyse-jvm-i- analyse-jvm-i* analyse-jvm-idiv analyse-jvm-irem analyse-jvm-getstatic - analyse-jvm-invokevirtual])) - -;; [Interface] -(defn analyse [module-name tokens] - (match ((repeat-m (with-scope module-name - analyse-form)) {:name module-name, - :forms tokens - :deps {} - :imports {} - :defs {} - :defs-env {} - :lambda-scope [[] 0] - :env (list (fresh-env 0)) - :types &type/+init+}) - [::&util/ok [?state ?forms]] - (if (empty? (:forms ?state)) - ?forms - (assert false (str "Unconsumed input: " (pr-str (:forms ?state))))) - - [::&util/failure ?message] - (assert false ?message))) + analyse-jvm-invokevirtual + ])) diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index 9ffee56dc..a98687971 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -140,7 +140,8 @@ (defcompiler ^:private compile-tuple [::&analyser/tuple ?elems] - (let [num-elems (count ?elems)] + (let [;; _ (prn 'compile-tuple (count ?elems)) + num-elems (count ?elems)] (let [tuple-class (str "test2/Tuple" num-elems)] (doto *writer* (.visitTypeInsn Opcodes/NEW tuple-class) @@ -896,33 +897,6 @@ ;; (load-class! (string/replace module-name #"/" ".") (str module-name ".class")) nil)) -(defn quoted->token [quoted] - ;; (prn 'quoted->token quoted) - (match quoted - [::&parser/text ?text] - {:form [::&analyser/variant "Text" (list {:form [::&analyser/literal ?text] - :type [::&type/object "java.lang.String" []]})] - :type [::&type/variant "Text" (list [::&type/object "java.lang.String" []])]} - - [::&parser/fn-call ?fn ?args] - (let [members* (quoted->token (cons ?fn ?args))] - {:form [::&analyser/variant "Form" (list members*)] - :type [::&type/variant "Form" (list (:type members*))]}) - - ([] :seq) - {:form [::&analyser/variant "Nil" '()] - :type [::&type/variant "Nil" '()]} - - ([head & tail] :seq) - (let [head* (quoted->token head) - tail* (quoted->token tail)] - {:form [::&analyser/variant "Cons" (list head* tail*)] - :type [::&type/variant "Nil" (list (:type head*) (:type tail*))]}))) - -(defcompiler compile-quote - [::&analyser/quote ?quoted] - (compile-form (assoc *state* :form (quoted->token ?quoted)))) - (let [+int-class+ (->class "java.lang.Integer")] (do-template [<name> <tag> <opcode>] (defcompiler <name> @@ -966,7 +940,6 @@ compile-definterface compile-import compile-use - compile-quote compile-jvm-i+ compile-jvm-i- compile-jvm-i* @@ -1007,7 +980,7 @@ [::&util/ok [?state ?forms]] (if (empty? (:forms ?state)) ?forms - (assert false (str "Unconsumed input: " (pr-str (:forms ?state))))) + (assert false (str "Unconsumed input: " (pr-str (first (:forms ?state)))))) [::&util/failure ?message] (assert false ?message)) diff --git a/src/lux/parser.clj b/src/lux/parser.clj index db64adf4a..d25208dc5 100644 --- a/src/lux/parser.clj +++ b/src/lux/parser.clj @@ -7,7 +7,7 @@ [lexer :as &lexer] [type :as &type]))) -(declare parse-form) +(declare parse-token) ;; [Utils] (defmacro ^:private defparser [name match return] @@ -20,33 +20,23 @@ (fail* (str "Unmatched token: " token#)))))) ;; [Parsers] -(do-template [<name> <input-tag> <output-tag> <method>] - (defparser <name> - [<input-tag> ?value] - (return [<output-tag> (<method> ?value)])) - - - ^:private parse-bool ::&lexer/bool ::bool Boolean/parseBoolean - ^:private parse-int ::&lexer/int ::int Integer/parseInt - ^:private parse-real ::&lexer/real ::real Float/parseFloat - ) - -(defparser ^:private parse-char - [::&lexer/char ?value] - (return [::char (.charAt ?value 0)])) - -(defn ident->string [ident] - (match ident - [::&lexer/ident ?ident] - ?ident)) - -(defparser ^:private parse-ident - [::&lexer/ident ?ident] - (return [::ident ?ident])) +(let [first-char #(.charAt % 0)] + (do-template [<name> <input-tag> <output-tag> <method>] + (defparser <name> + [<input-tag> ?value] + (return [<output-tag> (<method> ?value)])) + + ^:private parse-bool ::&lexer/bool ::bool Boolean/parseBoolean + ^:private parse-int ::&lexer/int ::int Integer/parseInt + ^:private parse-real ::&lexer/real ::real Float/parseFloat + ^:private parse-char ::&lexer/char ::char first-char + ^:private parse-text ::&lexer/text ::text identity + ^:private parse-ident ::&lexer/ident ::ident identity + )) (defparser ^:private parse-tuple [::&lexer/tuple ?parts] - (exec [=parts (map-m (fn [arg] (apply-m parse-form (list arg))) + (exec [=parts (map-m (fn [arg] (apply-m parse-token (list arg))) ?parts)] (return [::tuple =parts]))) @@ -55,161 +45,38 @@ (exec [=kvs (do (assert (even? (count ?parts))) (map-m #(match % ([[::&lexer/tag ?label] ?value] :seq) - (exec [=value (apply-m parse-form (list ?value))] + (exec [=value (apply-m parse-token (list ?value))] (return [?label =value]))) (partition 2 ?parts)))] (return [::record =kvs]))) -(defparser ^:private parse-lambda - [::&lexer/list ([[::&lexer/ident "lambda"] [::&lexer/tuple ?args] ?body] :seq)] - (exec [=body (apply-m parse-form (list ?body))] - (return [::lambda (mapv ident->string ?args) =body]))) - -(defparser ^:private parse-def - [::&lexer/list ([[::&lexer/ident "def"] ?name ?body] :seq)] - (exec [=name (apply-m parse-form (list ?name)) - =body (apply-m parse-form (list ?body))] - (return [::def =name =body]))) - -(defparser ^:private parse-defmacro - [::&lexer/list ([[::&lexer/ident "defmacro"] ?name ?body] :seq)] - (exec [=name (apply-m parse-form (list ?name)) - =body (apply-m parse-form (list ?body))] - (return [::defmacro =name =body]))) - -(defparser ^:private parse-if - [::&lexer/list ([[::&lexer/ident "if"] ?test ?then ?else] :seq)] - (exec [=test (apply-m parse-form (list ?test)) - =then (apply-m parse-form (list ?then)) - =else (apply-m parse-form (list ?else))] - (return [::if =test =then =else]))) - -(defparser ^:private parse-do - [::&lexer/list ([[::&lexer/ident "do"] & ?exprs] :seq)] - (exec [=exprs (map-m #(apply-m parse-form (list %)) - ?exprs)] - (return [::do =exprs]))) - -(defparser ^:private parse-case - [::&lexer/list ([[::&lexer/ident "case"] ?variant & cases] :seq)] - (exec [=variant (apply-m parse-form (list ?variant)) - =branches (do (assert (even? (count cases))) - (map-m (fn [[destruct expr]] - (exec [=destruct (apply-m parse-form (list destruct)) - =expr (apply-m parse-form (list expr))] - (return [::case-branch =destruct =expr]))) - (partition 2 cases)))] - (return [::case =variant =branches]))) - -(defparser ^:private parse-let - [::&lexer/list ([[::&lexer/ident "let"] [::&lexer/ident ?label] ?value ?body] :seq)] - (exec [=value (apply-m parse-form (list ?value)) - =body (apply-m parse-form (list ?body))] - (return [::let ?label =value =body]))) - -(defparser ^:private parse-import - [::&lexer/list ([[::&lexer/ident "import"] [::&lexer/ident ?class]] :seq)] - (return [::import ?class])) - -(defparser ^:private parse-use - [::&lexer/list ([[::&lexer/ident "use"] [::&lexer/text ?file] [::&lexer/ident "as"] [::&lexer/ident ?alias]] :seq)] - (return [::use ?file ?alias])) - -(defparser ^:private parse-defclass - [::&lexer/list ([[::&lexer/ident "jvm/defclass"] [::&lexer/ident ?name] - [::&lexer/ident ?super-class] - [::&lexer/tuple ?fields]] :seq)] - (let [fields (for [field ?fields] - (match field - [::&lexer/tuple ([[::&lexer/ident ?class] [::&lexer/ident ?field]] :seq)] - [?class ?field]))] - (return [::defclass ?name ?super-class fields]))) - -(defparser ^:private parse-definterface - [::&lexer/list ([[::&lexer/ident "jvm/definterface"] [::&lexer/ident ?name] & ?members] :seq)] - (let [members (for [field ?members] - (match field - [::&lexer/list ([[::&lexer/ident ":"] [::&lexer/ident ?member] [::&lexer/list ([[::&lexer/ident "->"] [::&lexer/tuple ?inputs] ?output] :seq)]] :seq)] - [?member [(map ident->string ?inputs) (ident->string ?output)]]))] - (return [::definterface ?name members]))) - -(defparser ^:private parse-variant - ?token - (match ?token - [::&lexer/tag ?tag] - (return [::variant ?tag '()]) - - [::&lexer/list ([[::&lexer/tag ?tag] & ?data] :seq)] - (exec [=data (map-m #(apply-m parse-form (list %)) - ?data)] - (return [::variant ?tag =data])) - - _ - (fail (str "Unmatched token: " ?token)))) - -(defparser ^:private parse-get - [::&lexer/list ([[::&lexer/ident "get@"] [::&lexer/tag ?tag] ?record] :seq)] - (exec [=record (apply-m parse-form (list ?record))] - (return [::get ?tag =record]))) - -(defparser ^:private parse-remove - [::&lexer/list ([[::&lexer/ident "remove@"] [::&lexer/tag ?tag] ?record] :seq)] - (exec [=record (apply-m parse-form (list ?record))] - (return [::remove ?tag =record]))) - -(defparser ^:private parse-set - [::&lexer/list ([[::&lexer/ident "set@"] [::&lexer/tag ?tag] ?value ?record] :seq)] - (exec [=value (apply-m parse-form (list ?value)) - =record (apply-m parse-form (list ?record))] - (return [::set ?tag =value =record]))) - -(defparser ^:private parse-text - [::&lexer/text ?text] - (return [::text ?text])) - -;; (defparser ^:private parse-access -;; [::&lexer/list ([[::&lexer/ident "::"] ?object ?call] :seq)] -;; (exec [=object (apply-m parse-form (list ?object)) -;; =call (apply-m parse-form (list ?call))] -;; (return [::access =object =call]))) - -(defparser ^:private parse-jvm-getstatic - [::&lexer/list ([[::&lexer/ident "jvm/getstatic"] [::&lexer/ident ?class] [::&lexer/ident ?field]] :seq)] - (return [::jvm-getstatic ?class ?field])) - -(defparser ^:private parse-jvm-invokevirtual - [::&lexer/list ([[::&lexer/ident "jvm/invokevirtual"] - [::&lexer/ident ?class] [::&lexer/text ?method] [::&lexer/tuple ?classes] - ?object [::&lexer/tuple ?args]] - :seq)] - (exec [=object (apply-m parse-form (list ?object)) - =args (map-m #(apply-m parse-form (list %)) - ?args)] - (return [::jvm-invokevirtual ?class ?method (map ident->string ?classes) =object =args]))) - -(defparser ^:private parse-fn-call - [::&lexer/list ([?f & ?args] :seq)] - (exec [=f (apply-m parse-form (list ?f)) - =args (map-m (fn [arg] (apply-m parse-form (list arg))) - ?args)] - (return [::fn-call =f =args]))) - -;; Java interop -(do-template [<name> <ident> <tag>] - (defparser <name> - [::&lexer/list ([[::&lexer/ident <ident>] ?x ?y] :seq)] - (exec [=x (apply-m parse-form (list ?x)) - =y (apply-m parse-form (list ?y))] - (return [<tag> =x =y]))) - - ^:private parse-jvm-i+ "jvm/i+" ::jvm-i+ - ^:private parse-jvm-i- "jvm/i-" ::jvm-i- - ^:private parse-jvm-i* "jvm/i*" ::jvm-i* - ^:private parse-jvm-idiv "jvm/i/" ::jvm-idiv - ^:private parse-jvm-irem "jvm/irem" ::jvm-irem - ) - -(def ^:private parse-form +(defparser ^:private parse-tag + [::&lexer/tag ?tag] + (return [::tag ?tag])) + +(defparser ^:private parse-form + [::&lexer/list ?elems] + (exec [=elems (map-m (fn [arg] (apply-m parse-token (list arg))) + ?elems)] + (return [::form =elems]))) + +;; (defparser ^:private parse-get +;; [::&lexer/list ([[::&lexer/ident "get@"] [::&lexer/tag ?tag] ?record] :seq)] +;; (exec [=record (apply-m parse-token (list ?record))] +;; (return [::get ?tag =record]))) + +;; (defparser ^:private parse-remove +;; [::&lexer/list ([[::&lexer/ident "remove@"] [::&lexer/tag ?tag] ?record] :seq)] +;; (exec [=record (apply-m parse-token (list ?record))] +;; (return [::remove ?tag =record]))) + +;; (defparser ^:private parse-set +;; [::&lexer/list ([[::&lexer/ident "set@"] [::&lexer/tag ?tag] ?value ?record] :seq)] +;; (exec [=value (apply-m parse-token (list ?value)) +;; =record (apply-m parse-token (list ?record))] +;; (return [::set ?tag =value =record]))) + +(def ^:private parse-token (try-all-m [parse-bool parse-int parse-real @@ -218,33 +85,12 @@ parse-ident parse-tuple parse-record - parse-lambda - parse-def - parse-defmacro - parse-if - parse-do - parse-case - parse-let - parse-variant - parse-get - parse-set - parse-remove - parse-defclass - parse-definterface - parse-import - parse-use - parse-jvm-i+ - parse-jvm-i- - parse-jvm-i* - parse-jvm-idiv - parse-jvm-irem - parse-jvm-getstatic - parse-jvm-invokevirtual - parse-fn-call])) + parse-tag + parse-form])) ;; [Interface] (defn parse [text] - (match ((repeat-m parse-form) text) + (match ((repeat-m parse-token) text) [::&util/ok [?state ?forms]] (if (empty? ?state) ?forms @@ -96,15 +96,46 @@ (#Cons head (template tail)) ))) +(def (map f xs) + (case xs + #Nil + #Nil + + (#Cons x xs*) + (#Cons (f x) (map f xs*)))) + +(def (convert-list f xs) + (case xs + #Nil + (#Tag "Nil") + + (#Cons x xs*) + (#Form (#Cons (#Tag "Cons") (#Cons (f x) (#Cons (convert-list f xs*) #Nil)))))) + +(def (convert token) + (case token + (#Tag tag) + (#Form (#Cons (#Tag "Tag") (#Cons (#Text tag) #Nil))) + + (#Text text) + (#Form (#Cons (#Tag "Text") (#Cons (#Text text) #Nil))) + + (#Ident ident) + (#Form (#Cons (#Tag "Ident") (#Cons (#Text ident) #Nil))) + + (#Form elems) + (#Form (#Cons (#Tag "Form") (#Cons (convert-list convert elems) #Nil))) + )) + (defmacro (' form) (case form (#Cons form* #Nil) (case form* (#Form elems) - (#Quote (#Form (template elems))) + (convert (#Form (template elems))) _ - (#Quote form*) + (convert form) ))) ## Utils @@ -162,22 +193,22 @@ (jvm/invokevirtual Object "equals" [Object] x [y])) -#( (def (as-pairs list) - (case list - (#Cons x (#Cons y list*)) - (#Cons [x y] (as-pairs list*)) +(def (as-pairs list) + (case list + (#Cons x (#Cons y list*)) + (#Cons [x y] (as-pairs list*)) - _ - #Nil)) + _ + #Nil)) - (defmacro (exec tokens) +#( (defmacro (exec tokens) (case tokens (#Cons (#Tuple steps) (#Cons return #Nil)) - (if (= 0 (mod (length steps) 2)) + (if (= 0 (rem (length steps) 2)) (fold (lambda [inner pair] (case pair [label computation] - (` (bind (~ computation) + (' (bind (~ computation) (lambda [(~ label)] (~ inner)))))) return (as-pairs steps)) |