diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/lux.clj | 9 | ||||
| -rw-r--r-- | src/lux/analyser.clj | 853 | ||||
| -rw-r--r-- | src/lux/compiler.clj | 62 | ||||
| -rw-r--r-- | src/lux/lexer.clj | 62 | ||||
| -rw-r--r-- | src/lux/parser.clj | 139 | ||||
| -rw-r--r-- | src/lux/util.clj | 14 |
6 files changed, 535 insertions, 604 deletions
diff --git a/src/lux.clj b/src/lux.clj index d5c76cea9..045e6b0f2 100644 --- a/src/lux.clj +++ b/src/lux.clj @@ -18,15 +18,18 @@ ;; TODO: Add records. ;; TODO: throw, try, catch, finally ;; TODO: Add extra arities (apply2, apply3, ..., apply16) - ;; TODO: When doing partial application, skip "apply" and just call constructor appropiatedly. - ;; TODO: Add "new". Allow setting fields. + ;; TODO: Allow setting fields. ;; TODO: monitor enter & monitor exit. ;; TODO: Reinplement "if" as a macro on top of case. ;; TODO: Remember to optimized calling global functions. ;; TODO: Reader macros. + ;; TODO: Automatic currying of functions. + ;; TODO: + ;; TODO: + ;; TODO: ;; TODO: - (&compiler/compile-all ["lux" "test2"]) + (time (&compiler/compile-all ["lux" "test2"])) diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index fd7a5a5d0..d2c64c8df 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -4,178 +4,139 @@ [template :refer [do-template]]) [clojure.core.match :refer [match]] (lux [util :as &util :refer [exec return* return fail fail* - repeat-m exhaust-m try-m try-all-m map-m reduce-m - apply-m within + repeat-m try-all-m map-m reduce-m + within do-all-m* normalize-ident loader]] + [lexer :as &lexer] [parser :as &parser] [type :as &type]))) -(declare analyse-form - ->tokens - tokens->clojure) - ;; [Util] +(def +int-class+ "java.lang.Integer") + (defn ^:private annotated [form type] {:form form :type type}) -(defn fresh-env [id] - {:id id +(defn fresh-env [name] + {:name name + :inner-closures 0 :counter 0 :mappings {} :closure/id 0}) (def ^:private module-name (fn [state] - [::&util/ok [state (:name state)]])) - -(defn ^:private define [name desc] - (fn [state] - [::&util/ok [(-> state - (assoc-in [:modules (:name state) name] desc) - (assoc-in [:defs-env name] (annotated [::global (:name state) name] (:type desc)))) - nil]])) + [::&util/ok [state (::current-module state)]])) -(defn ^:private define-fn [name desc] +(defn ^:private annotate [name mode access macro? type] (fn [state] - [::&util/ok [(-> state - (assoc-in [:modules (:name state) name] desc) - (assoc-in [:defs-env name] (annotated [::global-fn (:name state) name] (:type desc)))) + [::&util/ok [(assoc-in state [::modules (::current-module state) name] {:mode mode + :access access + :macro? macro? + :type type + :defined? false}) nil]])) -(defn ^:private is-macro? [module name] +(defn ^:private define [name] (fn [state] - [::&util/ok [state (= (get-in state [:modules module name :mode]) ::macro)]])) - -(def ^:private next-local-idx - (fn [state] - [::&util/ok [state (-> state :env first :counter)]])) - -(def ^:private scope-id + (if-let [{:keys [mode type]} (get-in state [::modules (::current-module state) name])] + (let [full-name (str (::current-module state) ":" name) + tag (if (= ::function mode) + ::global-fn + ::global) + bound (annotated [tag (::current-module state) name] type)] + [::&util/ok [(-> state + (assoc-in [::modules (::current-module state) name :defined?] true) + (update-in [::global-env] merge {full-name bound, name bound})) + nil]]) + (fail* (str "Can't define an unannotated element [" name "]"))))) + +(defn ^:private defined? [name] (fn [state] - [::&util/ok [state (-> state :env first :id)]])) + [::&util/ok [state (get-in state [::modules (::current-module state) name :defined?])]])) -(def ^:private my-frame +(defn ^:private annotated? [name] (fn [state] - [::&util/ok [state (-> state :env first)]])) + [::&util/ok [state (boolean (get-in state [::modules (::current-module state) name]))]])) -(defn ^:private in-scope? [module name] +(defn ^:private is-macro? [module name] (fn [state] - [::&util/ok [state (some (partial = name) (get-in state [:lambda-scope 0]))]])) + [::&util/ok [state (boolean (get-in state [::modules module name :macro?]))]])) -(defn with-scope [scope body] +(def ^:private next-local-idx (fn [state] - (let [=return (body (-> state - (update-in [:lambda-scope 0] conj scope) - (assoc-in [:lambda-scope 1] 0)))] - (match =return - [::&util/ok [?state ?value]] - [::&util/ok [(assoc ?state :lambda-scope (:lambda-scope state)) ?value]] - - _ - =return)))) + [::&util/ok [state (-> state ::local-envs first :counter)]])) -(defn ^:private with-scoped-name [name type body] +(def ^:private scope-id (fn [state] - (let [=return (body (update-in state [:env] - #(cons (assoc-in (first %) [:mappings name] (annotated [::global-fn (:name state) name] type)) - (rest %))))] - (match =return - [::&util/ok [?state ?value]] - [::&util/ok [(update-in ?state [:env] #(cons (update-in (first %) [:mappings] dissoc name) - (rest %))) - ?value]] - - _ - =return)))) + [::&util/ok [state (-> state ::local-envs first :name)]])) -(defn ^:private with-lambda-scope [body] +(defn with-env [label body] (fn [state] - (let [=return (body (-> state - (update-in [:lambda-scope 0] conj (get-in state [:lambda-scope 1])) - (assoc-in [:lambda-scope 1] 0)))] + (let [=return (body (update-in state [::local-envs] conj (fresh-env label)))] (match =return [::&util/ok [?state ?value]] - [::&util/ok [(-> ?state - (update-in [:lambda-scope 0] pop) - (assoc-in [:lambda-scope 1] (inc (get-in state [:lambda-scope 1])))) - ?value]] + [::&util/ok [(update-in ?state [::local-envs] rest) ?value]] _ =return)))) -(def ^:private scope - (fn [state] - [::&util/ok [state (get-in state [:lambda-scope 0])]])) - -(defn ^:private with-local [name type body] +(defn ^:private with-local [name value body] (fn [state] - (let [=return (body (update-in state [:env] - #(cons (-> (first %) - (update-in [:counter] inc) - (assoc-in [:mappings name] (annotated [::local (:id (first %)) (:counter (first %))] type))) - (rest %))))] + (let [=return (body (update-in state [::local-envs] + (fn [[env & other-envs]] + (cons (assoc-in env [:mappings name] value) + other-envs))))] (match =return [::&util/ok [?state ?value]] - [::&util/ok [(update-in ?state [:env] #(cons (-> (first %) - (update-in [:counter] dec) - (update-in [:mappings] dissoc name)) - (rest %))) + [::&util/ok [(update-in ?state [::local-envs] #(cons (update-in (first %) [:mappings] dissoc name) + (rest %))) ?value]] _ =return) ))) -(defn ^:private with-locals [mappings monad] +(defn ^:private with-let [name type body] (fn [state] - (let [=return (monad (update-in state [:env] #(cons (update-in (first %) [:mappings] merge mappings) - (rest %))))] + (let [[top & stack] (::local-envs state) + body* (with-local name (annotated [::local (:name top) (:counter top)] type) + body) + =return (body* (assoc state ::local-envs (cons (update-in top [:counter] inc) stack)))] (match =return [::&util/ok [?state ?value]] - [::&util/ok [(update-in ?state [:env] #(cons (update-in (first %) [:mappings] (fn [m] (apply dissoc m (keys mappings)))) - (rest %))) + [::&util/ok [(update-in ?state [::local-envs] (fn [[top* & stack*]] + (cons (update-in top* [:counter] dec) + stack*))) ?value]] _ =return)))) -(defn ^:private with-fresh-env [[args-vars args-types] body] - (with-lambda-scope - (fn [state] - (let [state* (update-in state [:env] - (fn [outer] - (let [frame-id (-> outer first :id inc) - new-top (reduce (fn [frame [name type]] - (-> frame - (update-in [:counter] inc) - (assoc-in [:mappings name] (annotated [::local frame-id (:counter frame)] type)))) - (update-in (fresh-env frame-id) [:counter] inc) - (map vector args-vars args-types))] - (conj outer new-top)))) - =return (body state*)] - (match =return - [::&util/ok [?state ?value]] - [::&util/ok [(update-in ?state [:env] rest) - [(get-in ?state [:lambda-scope 0]) - (-> ?state :env first (update-in [:mappings] #(reduce dissoc % args-vars))) - ?value]]] - - _ - =return))))) - -(defn ^:private import-class [long-name short-name] - (fn [state] - (let [=class (annotated [::class long-name] [::&type/object long-name []])] - [::&util/ok [(update-in state [:imports] merge {long-name =class, - short-name =class}) - nil]]))) +(do-template [<name> <unit-fn>] + (defn <name> [locals monad] + (reduce (fn [inner [label elem]] + (<unit-fn> label elem inner)) + monad + (reverse locals))) + + ^:private with-locals with-local + ^:private with-lets with-let + ) -(defn ^:private use-module [name alias] +(defn with-lambda [args body] (fn [state] - [::&util/ok [(assoc-in state [:deps alias] name) - nil]])) + (let [top (-> state ::local-envs first) + scope* (str (:name top) "$" (str (:inner-closures top))) + body* (with-env scope* + (with-lets args + (exec [=return body] + (return [scope* =return]))))] + (body* (update-in state [::local-envs] #(cons (update-in (first %) [:inner-closures] inc) + (rest %)))) + ))) (defn ^:private close-over [scope ident register frame] (let [register* (annotated [::captured scope (:closure/id frame) register] (:type register))] @@ -185,93 +146,23 @@ (defn ^:private resolve [ident] (fn [state] - (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 "[Analyser Error] 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 - (fn [{[token# & left#] :forms :as state#}] - (match token# - ~match - (~return (assoc state# :forms left#)) - - _# - (fail* (str "[Analyser Error] Unmatched token: " token#)))))) - -(defn analyse-form* [form] - (fn [state] - (let [old-forms (:forms state) - =return (analyse-form (assoc state :forms (list form)))] - (match =return - [::&util/ok [?state ?value]] - [::&util/ok [(assoc ?state :forms old-forms) ?value]] - - [::&util/failure ?message] - [::&util/failure ?message])))) - -(do-template [<name> <tag> <class>] - (defanalyser <name> - [<tag> ?value] - (return (annotated [::literal ?value] [::&type/object <class> []]))) - - analyse-bool ::&parser/bool "java.lang.Boolean" - analyse-int ::&parser/int "java.lang.Integer" - analyse-real ::&parser/real "java.lang.Float" - analyse-char ::&parser/char "java.lang.Character" - analyse-text ::&parser/text "java.lang.String" - ) - -(defanalyser analyse-variant - ?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] - (exec [=elems (map-m analyse-form* ?elems)] - (return (annotated [::tuple =elems] [::&type/tuple (mapv :type =elems)])))) - -(defanalyser analyse-ident - [::&parser/ident ?ident] - (resolve ?ident)) - -(defanalyser analyse-access - [::&parser/static-access ?target ?member] - (exec [=target (resolve ?target)] - (match (:form =target) - [::class ?class] - (return (annotated [::static-access ?class ?member] ::&type/nothing))))) + (let [[top & stack*] (::local-envs state)] + (if-let [=bound (get-in top [:mappings ident])] + [::&util/ok [state (list =bound)]] + (let [[inner outer] (split-with #(-> % :mappings (contains? ident) not) stack*)] + (if (empty? outer) + (if-let [global|import (get-in state [::global-env ident])] + [::&util/ok [state (list global|import)]] + [::&util/failure (str "[Analyser Error] Unresolved identifier: " ident)]) + (let [[=local inner*] (reduce (fn [[register new-inner] frame] + (let [[register* frame*] (close-over (:name frame) ident register frame)] + [register* (cons frame* new-inner)])) + [(-> outer first :mappings (get ident)) '()] + (reverse (cons top inner)))] + [::&util/ok [(assoc state ::local-envs (concat inner* outer)) (list =local)]]) + )) + )) + )) (defn extract-ident [ident] (match ident @@ -336,31 +227,7 @@ _ (fail ""))) -(defn lookup-field [mode target field] - (if-let [[[owner type]] (seq (for [=field (.getFields (Class/forName target)) - :when (and (= field (.getName =field)) - (case mode - :static (java.lang.reflect.Modifier/isStatic (.getModifiers =field)) - :dynamic (not (java.lang.reflect.Modifier/isStatic (.getModifiers =field)))))] - [(.getDeclaringClass =field) (.getType =field)]))] - (exec [=type (&type/class->type type)] - (return [(.getName owner) =type])) - (fail (str "[Analyser Error] Field does not exist: " target field mode)))) - -(defn lookup-method [mode target method args] - (if-let [methods (seq (for [=method (.getMethods (Class/forName target)) - :when (and (= method (.getName =method)) - (case mode - :static (java.lang.reflect.Modifier/isStatic (.getModifiers =method)) - :virtual (not (java.lang.reflect.Modifier/isStatic (.getModifiers =method)))))] - [(.getDeclaringClass =method) =method]))] - (map-m (fn [[owner method]] - (exec [=method (&type/method->type method)] - (return [(.getName owner) =method]))) - methods) - (fail (str "[Analyser Error] Method does not exist: " target method mode)))) - -(defn lookup-static-field [target field] +(defn ^:private lookup-static-field [target field] (if-let [type* (first (for [=field (.getFields target) :when (and (= target (.getDeclaringClass =field)) (= field (.getName =field)) @@ -370,7 +237,7 @@ (return =type)) (fail (str "[Analyser Error] Field does not exist: " target field)))) -(defn lookup-virtual-method [target method-name args] +(defn ^:private lookup-virtual-method [target method-name args] (if-let [method (first (for [=method (.getMethods target) :when (and (= target (.getDeclaringClass =method)) (= method-name (.getName =method)) @@ -380,7 +247,7 @@ (&type/return-type =method)) (fail (str "[Analyser Error] Virtual method does not exist: " target method-name)))) -(defn full-class-name [class] +(defn ^:private full-class-name [class] (if (.contains class ".") (return class) (try-all-m [(exec [=class (resolve class)] @@ -397,45 +264,17 @@ (return full-name) (fail "[Analyser Error] Unknown class.")))]))) -(defanalyser analyse-jvm-getstatic - [::&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/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 extract-jvm-param ?classes) - =return (lookup-virtual-method (Class/forName =class) ?method =classes) - =object (analyse-form* ?object) - =args (map-m analyse-form* ?args)] - (return (annotated [::jvm-invokevirtual =class ?method (map #(.getName %) =classes) =object =args] =return)))) - -(defanalyser analyse-jvm-new - [::&parser/form ([[::&parser/ident "jvm/new"] [::&parser/ident ?class] [::&parser/tuple ?classes] [::&parser/tuple ?args]] :seq)] - (exec [=class (full-class-name ?class) - =classes (map-m extract-jvm-param ?classes) - =args (map-m analyse-form* ?args)] - (return (annotated [::jvm-new =class (map #(.getName %) =classes) =args] [::&type/object =class []])))) - -(defanalyser analyse-jvm-new-array - [::&parser/form ([[::&parser/ident "jvm/new-array"] [::&parser/ident ?class] [::&parser/int ?length]] :seq)] - (exec [=class (full-class-name ?class)] - (return (annotated [::jvm-new-array =class ?length] [::&type/array [::&type/object =class []]])))) - -(defanalyser analyse-jvm-aastore - [::&parser/form ([[::&parser/ident "jvm/aastore"] ?array [::&parser/int ?idx] ?elem] :seq)] - (exec [=array (analyse-form* ?array) - =elem (analyse-form* ?elem)] - (return (annotated [::jvm-aastore =array ?idx =elem] (:type =array))))) - -(defanalyser analyse-jvm-aaload - [::&parser/form ([[::&parser/ident "jvm/aaload"] ?array [::&parser/int ?idx]] :seq)] - (exec [=array (analyse-form* ?array)] - (return (annotated [::jvm-aaload =array ?idx] (-> =array :type (nth 1)))))) +(defn ^:private ->lux+* [->lux xs] + (reduce (fn [tail x] + (doto (.newInstance (.loadClass @loader "lux.Variant2")) + (-> .-tag (set! "Cons")) + (-> .-_1 (set! (->lux x))) + (-> .-_2 (set! tail)))) + (doto (.newInstance (.loadClass @loader "lux.Variant0")) + (-> .-tag (set! "Nil"))) + (reverse xs))) -(defn ->token [x] +(defn ^:private ->lux [x] (match x [::&parser/bool ?bool] (doto (.newInstance (.loadClass @loader "lux.Variant1")) @@ -468,24 +307,23 @@ [::&parser/tuple ?elems] (doto (.newInstance (.loadClass @loader "lux.Variant1")) (-> .-tag (set! "Tuple")) - (-> .-_1 (set! (->tokens ?elems)))) + (-> .-_1 (set! (->lux+* ->lux ?elems)))) [::&parser/form ?elems] (doto (.newInstance (.loadClass @loader "lux.Variant1")) (-> .-tag (set! "Form")) - (-> .-_1 (set! (->tokens ?elems)))) + (-> .-_1 (set! (->lux+* ->lux ?elems)))) )) -(defn ->tokens [xs] - (reduce (fn [tail x] - (doto (.newInstance (.loadClass @loader "lux.Variant2")) - (-> .-tag (set! "Cons")) - (-> .-_1 (set! (->token x))) - (-> .-_2 (set! tail)))) - (doto (.newInstance (.loadClass @loader "lux.Variant0")) - (-> .-tag (set! "Nil"))) - (reverse xs))) +(def ^:private ->lux+ (partial ->lux+* ->lux)) -(defn ->clojure-token [x] +(defn ->clojure+* [->clojure xs] + (case (.-tag xs) + "Nil" '() + "Cons" (cons (->clojure (.-_1 xs)) + (->clojure+* ->clojure (.-_2 xs))) + )) + +(defn ->clojure [x] (case (.-tag x) "Bool" [::&parser/bool (-> x .-_1)] "Int" [::&parser/int (-> x .-_1)] @@ -494,32 +332,31 @@ "Text" [::&parser/text (-> x .-_1)] "Tag" [::&parser/tag (-> x .-_1)] "Ident" [::&parser/ident (-> x .-_1)] - "Tuple" [::&parser/tuple (-> x .-_1 tokens->clojure)] - "Form" [::&parser/form (-> x .-_1 tokens->clojure)])) + "Tuple" [::&parser/tuple (->> x .-_1 (->clojure+* ->clojure))] + "Form" [::&parser/form (->> x .-_1 (->clojure+* ->clojure))])) -(defn tokens->clojure [xs] - (case (.-tag xs) - "Nil" '() - "Cons" (cons (->clojure-token (.-_1 xs)) - (tokens->clojure (.-_2 xs))) - )) +(def ^:private ->clojure+ (partial ->clojure+* ->clojure)) + +(defn ^:private analyse-tuple [analyse-ast ?elems] + (exec [=elems (do-all-m* (map analyse-ast ?elems))] + (return (list (annotated [::tuple =elems] [::&type/tuple (mapv :type =elems)]))))) -(defanalyser analyse-call - [::&parser/form ([?fn & ?args] :seq)] - (exec [=fn (analyse-form* ?fn)] +(defn ^:private analyse-ident [analyse-ast ?ident] + (resolve ?ident)) + +(defn ^:private analyse-call [analyse-ast ?fn ?args] + (exec [[=fn] (analyse-ast ?fn)] (match (:form =fn) [::global-fn ?module ?name] - (exec [macro? (is-macro? ?module ?name) - scoped? (in-scope? ?module ?name)] - (if (and macro? (not scoped?)) - (let [macro-class (str ?module "$" (normalize-ident ?name)) - transformed (-> (.loadClass @loader macro-class) - .newInstance - (.apply (->tokens ?args)) - ->clojure-token)] - (-> transformed - analyse-form*)) - (exec [=args (map-m analyse-form* ?args) + (exec [macro? (is-macro? ?module ?name)] + (if macro? + (let [macro-class (str ?module "$" (normalize-ident ?name))] + (-> (.loadClass @loader macro-class) + .newInstance + (.apply (->lux+ ?args)) + ->clojure + analyse-ast)) + (exec [=args (do-all-m* (map analyse-ast ?args)) :let [[needs-num =return-type] (match (:type =fn) [::&type/function ?fargs ?freturn] (let [needs-num (count ?fargs) @@ -527,24 +364,22 @@ (if (> needs-num provides-num) [needs-num [::&type/function (drop provides-num ?fargs) ?freturn]] [needs-num [::&type/object "java.lang.Object" []]])))]] - (return (annotated [::static-call needs-num =fn =args] =return-type))))) + (return (list (annotated [::static-call needs-num =fn =args] =return-type)))))) _ - (exec [=args (map-m analyse-form* ?args)] - (return (annotated [::call =fn =args] [::&type/object "java.lang.Object" []])))) + (exec [=args (do-all-m* (map analyse-ast ?args))] + (return (list (annotated [::call =fn =args] [::&type/object "java.lang.Object" []]))))) )) -(defanalyser analyse-if - [::&parser/form ([[::&parser/ident "if"] ?test ?then ?else] :seq)] - (exec [=test (analyse-form* ?test) - =then (analyse-form* ?then) - =else (analyse-form* ?else)] - (return (annotated [::if =test =then =else] ::&type/nothing)))) +(defn ^:private analyse-if [analyse-ast ?test ?then ?else] + (exec [[=test] (analyse-ast ?test) + [=then] (analyse-ast ?then) + [=else] (analyse-ast ?else)] + (return (list (annotated [::if =test =then =else] ::&type/nothing))))) -(defanalyser analyse-do - [::&parser/form ([[::&parser/ident "do"] & ?exprs] :seq)] - (exec [=exprs (map-m analyse-form* ?exprs)] - (return (annotated [::do =exprs] (-> =exprs last :type))))) +(defn ^:private analyse-do [analyse-ast ?exprs] + (exec [=exprs (do-all-m* (map analyse-ast ?exprs))] + (return (list (annotated [::do =exprs] (-> =exprs last :type)))))) (let [fold-branch (fn [struct entry] (let [struct* (clojure.core.match/match (nth entry 0) @@ -724,70 +559,161 @@ [max-registers branch-mappings (generate-branches branches**)]))) (let [locals-getter (fn [$scope] - (fn member-fold [[$local locals-map] ?member] + (fn member-fold [[$local locals] ?member] (match ?member [::&parser/ident ?name] - (return [(inc $local) (assoc locals-map ?name (annotated [::local $scope $local] [::&type/object "java.lang.Object" []]))]) + (return [(inc $local) (cons [?name (annotated [::local $scope $local] [::&type/object "java.lang.Object" []])] locals)]) [::&parser/tuple ?submembers] - (reduce-m member-fold [$local locals-map] ?submembers) + (reduce-m member-fold [$local locals] ?submembers) [::&parser/form ([[::&parser/tag ?subtag] & ?submembers] :seq)] - (reduce-m member-fold [$local locals-map] ?submembers) + (reduce-m member-fold [$local locals] ?submembers) _ - (return [$local locals-map]) + (return [$local locals]) )))] - (defanalyser analyse-case - [::&parser/form ([[::&parser/ident "case"] ?variant & ?branches] :seq)] - (exec [=variant (analyse-form* ?variant) + (defn ^:private analyse-case [analyse-ast ?variant ?branches] + (exec [[=variant] (analyse-ast ?variant) $scope scope-id $base next-local-idx [registers mappings tree] (exec [=branches (map-m (fn [[?pattern ?body]] (match ?pattern [::&parser/char ?token] - (exec [=body (analyse-form* ?body)] + (exec [[=body] (analyse-ast ?body)] (return [::case-branch [::&parser/char ?token] =body])) [::&parser/text ?token] - (exec [=body (analyse-form* ?body)] + (exec [[=body] (analyse-ast ?body)] (return [::case-branch [::&parser/text ?token] =body])) [::&parser/ident ?name] - (exec [=body (with-locals {?name (annotated [::local $scope $base] [::&type/object "java.lang.Object" []])} - (analyse-form* ?body))] + (exec [[=body] (with-local ?name (annotated [::local $scope $base] [::&type/object "java.lang.Object" []]) + (analyse-ast ?body))] (return [::case-branch [::&parser/ident ?name] =body])) [::&parser/tag ?tag] - (exec [=body (analyse-form* ?body)] + (exec [[=body] (analyse-ast ?body)] (return [::case-branch [::&parser/variant ?tag '()] =body])) [::&parser/tuple ?members] - (exec [[_ locals+] (reduce-m (locals-getter $scope) [$base {}] ?members) - =body (with-locals locals+ - (analyse-form* ?body))] + (exec [[_ locals+] (reduce-m (locals-getter $scope) [$base '()] ?members) + [=body] (with-locals (reverse locals+) + (analyse-ast ?body))] (return [::case-branch [::&parser/tuple ?members] =body])) [::&parser/form ([[::&parser/tag ?tag] & ?members] :seq)] - (exec [[_ locals+] (reduce-m (locals-getter $scope) [$base {}] ?members) - =body (with-locals locals+ - (analyse-form* ?body))] + (exec [[_ locals+] (reduce-m (locals-getter $scope) [$base '()] ?members) + [=body] (with-locals (reverse locals+) + (analyse-ast ?body))] (return [::case-branch [::&parser/variant ?tag ?members] =body])) )) (partition 2 ?branches))] (return (->decision-tree $scope $base =branches)))] - (return (annotated [::case (dec $base) =variant registers mappings tree] ::&type/nothing))))) + (return (list (annotated [::case (dec $base) =variant registers mappings tree] ::&type/nothing)))))) -(defanalyser analyse-let - [::&parser/form ([[::&parser/ident "let"] [::&parser/ident ?label] ?value ?body] :seq)] - (exec [=value (analyse-form* ?value) +(defn ^:private analyse-let [analyse-ast ?label ?value ?body] + (exec [[=value] (analyse-ast ?value) idx next-local-idx - =body (with-local ?label (:type =value) - (analyse-form* ?body))] - (return (annotated [::let idx ?label =value =body] (:type =body))))) + [=body] (with-let ?label (:type =value) + (analyse-ast ?body))] + (return (list (annotated [::let idx ?label =value =body] (:type =body)))))) + +(defn ^:private analyse-lambda [analyse-ast ?args ?body] + (exec [?args (map-m extract-ident ?args) + [=function =args =return] (within ::types (&type/fresh-function (count ?args))) + [=scope =body] (with-lambda (map vector ?args =args) + (analyse-ast ?body)) + =function (within ::types (exec [_ (&type/solve =return (:type =body))] + (&type/clean =function)))] + (return (list (annotated [::lambda =scope ?args =body] =function))))) + +(defn ^:private analyse-def [analyse-ast ?usage ?value] + (match ?usage + [::&parser/ident ?name] + (exec [:let [scoped-name (str "def_" ?name)] + [=value] (with-env (str "def_" ?name) + (analyse-ast ?value)) + _ (annotate ?name ::constant ::public false (:type =value)) + _ (define ?name)] + (return (list (annotated [::def ?name =value] ::&type/nothing)))) + + [::&parser/form ([[::&parser/ident ?name] & ?args] :seq)] + (exec [def?? (defined? ?name)] + (if def?? + (fail (str "Can't redefine function/constant: " ?name)) + (exec [ann?? (annotated? ?name) + args (map-m extract-ident ?args) + [=function =args =return] (within ::types (&type/fresh-function (count args))) + :let [scoped-name (str "def_" ?name)] + current-module module-name + [=value] (with-env scoped-name + (with-local ?name (annotated [::global-fn current-module ?name] =function) + (with-lets (map vector args =args) + (analyse-ast ?value)))) + =function (within ::types (exec [_ (&type/solve =return (:type =value))] + (&type/clean =function))) + _ (if ann?? + (return nil) + (annotate ?name ::function ::public false =function)) + _ (define ?name)] + (return (list (annotated [::def [?name args] =value] ::&type/nothing)))))) + )) + +(defn ^:private analyse-annotate [?ident] + (exec [_ (annotate ?ident ::function ::public true ::&type/nothing)] + (return (list)))) + +(defn ^:private analyse-require [analyse-ast ?path] + (assert false) + (return (list))) + +(do-template [<name> <ident> <output-tag>] + (defn <name> [analyse-ast ?x ?y] + (exec [[=x] (analyse-ast ?x) + [=y] (analyse-ast ?y)] + (return (list (annotated [<output-tag> =x =y] [::&type/object +int-class+ []]))))) + + ^:private analyse-jvm-iadd "jvm:iadd" ::jvm:iadd + ^:private analyse-jvm-isub "jvm:isub" ::jvm:isub + ^:private analyse-jvm-imul "jvm:imul" ::jvm:imul + ^:private analyse-jvm-idiv "jvm:idiv" ::jvm:idiv + ^:private analyse-jvm-irem "jvm:irem" ::jvm:irem + ) -(defanalyser analyse-defclass - [::&parser/form ([[::&parser/ident "jvm/defclass"] [::&parser/ident ?name] [::&parser/ident ?super-class] [::&parser/tuple ?fields]] :seq)] +(defn ^:private analyse-jvm-getstatic [analyse-ast ?class ?field] + (exec [=class (full-class-name ?class) + =type (lookup-static-field (Class/forName =class) ?field)] + (return (list (annotated [::jvm:getstatic =class ?field] =type))))) + +(defn ^:private analyse-jvm-invokevirtual [analyse-ast ?class ?method ?classes ?object ?args] + (exec [=class (full-class-name ?class) + =classes (map-m extract-jvm-param ?classes) + =return (lookup-virtual-method (Class/forName =class) ?method =classes) + [=object] (analyse-ast ?object) + =args (do-all-m* (map analyse-ast ?args))] + (return (list (annotated [::jvm:invokevirtual =class ?method (map #(.getName %) =classes) =object =args] =return))))) + +(defn ^:private analyse-jvm-new [analyse-ast ?class ?classes ?args] + (exec [=class (full-class-name ?class) + =classes (map-m extract-jvm-param ?classes) + =args (do-all-m* (map analyse-ast ?args))] + (return (list (annotated [::jvm:new =class (map #(.getName %) =classes) =args] [::&type/object =class []]))))) + +(defn ^:private analyse-jvm-new-array [analyse-ast ?class ?length] + (exec [=class (full-class-name ?class)] + (return (list (annotated [::jvm:new-array =class ?length] [::&type/array [::&type/object =class []]]))))) + +(defn ^:private analyse-jvm-aastore [analyse-ast ?array ?idx ?elem] + (exec [[=array] (analyse-ast ?array) + [=elem] (analyse-ast ?elem)] + (return (list (annotated [::jvm:aastore =array ?idx =elem] (:type =array)))))) + +(defn ^:private analyse-jvm-aaload [analyse-ast ?array ?idx] + (exec [[=array] (analyse-ast ?array)] + (return (list (annotated [::jvm:aaload =array ?idx] (-> =array :type (nth 1))))))) + +(defn ^:private analyse-jvm-class [analyse-ast ?name ?super-class ?fields] (exec [?fields (map-m (fn [?field] (match ?field [::&parser/tuple ([[::&parser/ident ?class] [::&parser/ident ?field-name]] :seq)] @@ -800,10 +726,9 @@ [field {:access ::public :type class}]))}] name module-name] - (return (annotated [::defclass [name ?name] ?super-class =members] ::&type/nothing)))) + (return (list (annotated [::defclass [name ?name] ?super-class =members] ::&type/nothing))))) -(defanalyser analyse-definterface - [::&parser/form ([[::&parser/ident "jvm/definterface"] [::&parser/ident ?name] & ?members] :seq)] +(defn ^:private analyse-jvm-interface [analyse-ast ?name ?members] (exec [?members (map-m #(match % [::&parser/form ([[::&parser/ident ":"] [::&parser/ident ?member-name] [::&parser/form ([[::&parser/ident "->"] [::&parser/tuple ?inputs] [::&parser/ident ?output]] :seq)]] @@ -819,115 +744,139 @@ :type [inputs output]}]))} =interface [::interface ?name =members]] name module-name] - (return (annotated [::definterface [name ?name] =members] ::&type/nothing)))) + (return (list (annotated [::definterface [name ?name] =members] ::&type/nothing))))) -(defanalyser analyse-def - [::&parser/form ([[::&parser/ident "def"] ?usage ?value] :seq)] - (match ?usage - [::&parser/ident ?name] - (exec [=value (with-scope ?name - (analyse-form* ?value)) - _ (define ?name {:mode ::constant - :access ::public - :type (:type =value)})] - (return (annotated [::def ?name =value] ::&type/nothing))) +(defn ^:private analyse-basic-ast [analyse-ast token] + (match token + ;; Standard special forms + [::&parser/bool ?value] + (return (list (annotated [::literal ?value] [::&type/object "java.lang.Boolean" []]))) - [::&parser/form ([[::&parser/ident ?name] & ?args] :seq)] - (exec [args (map-m extract-ident ?args) - [=function =args =return] (within :types (&type/fresh-function (count args))) - =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))))) - =function (within :types (exec [_ (&type/solve =return (:type =value))] - (&type/clean =function))) - _ (define-fn ?name {:mode ::function - :access ::public - :type =function})] - (return (annotated [::def [?name args] =value] ::&type/nothing))) - )) + [::&parser/int ?value] + (return (list (annotated [::literal ?value] [::&type/object +int-class+ []]))) -(defanalyser analyse-defmacro - [::&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 - (with-local ?tokens =tokens - (analyse-form* ?value)))) - =function (within :types (exec [_ (&type/solve =return (:type =value))] - (&type/clean =function))) - _ (define-fn ?name {:mode ::macro - :access ::public - :type =function})] - (return (annotated [::def [?name (list ?tokens)] =value] ::&type/nothing)))) - -(defanalyser analyse-lambda - [::&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))) - [=scope =frame =body] (with-fresh-env [?args =args] - (analyse-form* ?body)) - =function (within :types (exec [_ (&type/solve =return (:type =body))] - (&type/clean =function)))] - (return (annotated [::lambda =scope =frame ?args =body] =function)))) - -(defanalyser analyse-import - [::&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/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))))) + [::&parser/real ?value] + (return (list (annotated [::literal ?value] [::&type/object "java.lang.Float" []]))) -(do-template [<name> <ident> <output-tag>] - (defanalyser <name> - [::&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+ "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 - ) + [::&parser/char ?value] + (return (list (annotated [::literal ?value] [::&type/object "java.lang.Character" []]))) + + [::&parser/text ?value] + (return (list (annotated [::literal ?value] [::&type/object "java.lang.String" []]))) + + [::&parser/tag ?tag] + (return (list (annotated [::variant ?tag '()] [::&type/variant ?tag '()]))) + + [::&parser/form ([[::&parser/tag ?tag] & ?data] :seq)] + (exec [=data (do-all-m* (map analyse-ast ?data))] + (return (list (annotated [::variant ?tag =data] [::&type/variant ?tag (map :type =data)])))) + + [::&parser/tuple ?elems] + (analyse-tuple analyse-ast ?elems) + + [::&parser/ident ?ident] + (analyse-ident analyse-ast ?ident) + + [::&parser/form ([[::&parser/ident "if"] ?test ?then ?else] :seq)] + (analyse-if analyse-ast ?test ?then ?else) + + [::&parser/form ([[::&parser/ident "let"] [::&parser/ident ?label] ?value ?body] :seq)] + (analyse-let analyse-ast ?label ?value ?body) + + [::&parser/form ([[::&parser/ident "case"] ?variant & ?branches] :seq)] + (analyse-case analyse-ast ?variant ?branches) + + [::&parser/form ([[::&parser/ident "lambda"] [::&parser/tuple ?args] ?body] :seq)] + (analyse-lambda analyse-ast ?args ?body) + + [::&parser/form ([[::&parser/ident "def"] ?usage ?value] :seq)] + (analyse-def analyse-ast ?usage ?value) -(def analyse-form - (try-all-m [analyse-bool - analyse-int - analyse-real - analyse-char - analyse-text - analyse-ident - analyse-tuple - analyse-variant - analyse-call - analyse-do - analyse-if - analyse-let - analyse-case - analyse-lambda - analyse-def - analyse-defmacro - analyse-defclass - analyse-definterface - analyse-use - analyse-import - analyse-jvm-i+ - analyse-jvm-i- - analyse-jvm-i* - analyse-jvm-idiv - analyse-jvm-irem - analyse-jvm-getstatic - analyse-jvm-invokevirtual - analyse-jvm-new - analyse-jvm-new-array - analyse-jvm-aastore - analyse-jvm-aaload - ])) + [::&parser/form ([[::&parser/ident "annotate"] [::&parser/ident ?ident] [::&parser/ident "Macro"]] :seq)] + (analyse-annotate ?ident) + + [::&parser/form ([[::&parser/ident "require"] [::&parser/text ?path]] :seq)] + (analyse-require analyse-ast ?path) + + ;; Host special forms + [::&parser/form ([[::&parser/ident "do"] & ?exprs] :seq)] + (analyse-do ?exprs) + + [::&parser/form ([[::&parser/ident "jvm:iadd"] ?x ?y] :seq)] + (analyse-jvm-iadd analyse-ast ?x ?y) + + [::&parser/form ([[::&parser/ident "jvm:isub"] ?x ?y] :seq)] + (analyse-jvm-isub analyse-ast ?x ?y) + + [::&parser/form ([[::&parser/ident "jvm:imul"] ?x ?y] :seq)] + (analyse-jvm-imul analyse-ast ?x ?y) + + [::&parser/form ([[::&parser/ident "jvm:idiv"] ?x ?y] :seq)] + (analyse-jvm-idiv analyse-ast ?x ?y) + + [::&parser/form ([[::&parser/ident "jvm:irem"] ?x ?y] :seq)] + (analyse-jvm-irem analyse-ast ?x ?y) + + [::&parser/form ([[::&parser/ident "jvm:getstatic"] [::&parser/ident ?class] [::&parser/ident ?field]] :seq)] + (analyse-jvm-getstatic analyse-ast ?class ?field) + + [::&parser/form ([[::&parser/ident "jvm:invokevirtual"] [::&parser/ident ?class] [::&parser/text ?method] [::&parser/tuple ?classes] ?object [::&parser/tuple ?args]] :seq)] + (analyse-jvm-invokevirtual analyse-ast ?class ?method ?classes ?object ?args) + + [::&parser/form ([[::&parser/ident "jvm:new"] [::&parser/ident ?class] [::&parser/tuple ?classes] [::&parser/tuple ?args]] :seq)] + (analyse-jvm-new analyse-ast ?class ?classes ?args) + + [::&parser/form ([[::&parser/ident "jvm:new-array"] [::&parser/ident ?class] [::&parser/int ?length]] :seq)] + (analyse-jvm-new-array analyse-ast ?class ?length) + + [::&parser/form ([[::&parser/ident "jvm:aastore"] ?array [::&parser/int ?idx] ?elem] :seq)] + (analyse-jvm-aastore analyse-ast ?array ?idx ?elem) + + [::&parser/form ([[::&parser/ident "jvm:aaload"] ?array [::&parser/int ?idx]] :seq)] + (analyse-jvm-aaload analyse-ast ?array ?idx) + + [::&parser/form ([[::&parser/ident "jvm:class"] [::&parser/ident ?name] [::&parser/ident ?super-class] [::&parser/tuple ?fields]] :seq)] + (analyse-jvm-class analyse-ast ?name ?super-class ?fields) + + [::&parser/form ([[::&parser/ident "jvm:interface"] [::&parser/ident ?name] & ?members] :seq)] + (analyse-jvm-interface analyse-ast ?name ?members) + + _ + (fail (str "[Analyser Error] Unmatched token: " token)))) + +(defn analyse-ast [token] + ;; (prn 'analyse-ast token) + (match token + [::&parser/form ([?fn & ?args] :seq)] + (try-all-m [(analyse-call analyse-ast ?fn ?args) + (analyse-basic-ast analyse-ast token)]) + + _ + (analyse-basic-ast analyse-ast token))) + +(def analyse + (exec [asts &parser/parse + ;; :let [_ (prn 'asts asts)] + ] + (do-all-m* (map analyse-ast asts)))) + +(comment + (do (defn analyse-all [] + (exec [?analyses analyse] + (fn [?state] + (if (empty? (::&lexer/source ?state)) + (return* ?state ?analyses) + ((exec [more-analyses (analyse-all)] + (return (concat ?analyses more-analyses))) + ?state))))) + + (let [name "lux"] + (&util/reset-loader!) + (time ((analyse-all) {::&lexer/source (slurp (str "source/" name ".lux")) + ::current-module name + ::modules {} + ::global-env {} + ::local-envs (list) + ::types &type/+init+}))) + ) + ) diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index 6d8cd08ff..676923258 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -6,6 +6,7 @@ [clojure.core.match :refer [match]] (lux [util :as &util :refer [exec return* return fail fail* repeat-m exhaust-m try-m try-all-m map-m reduce-m + do-all-m apply-m within normalize-ident loader reset-loader!]] @@ -174,7 +175,7 @@ (doto *writer* (.visitVarInsn Opcodes/ALOAD 0) (.visitFieldInsn Opcodes/GETFIELD - (apply str (interpose "$" (map (comp normalize-ident str) ?scope))) + (normalize-ident ?scope) (str "__" ?captured-id) "Ljava/lang/Object;"))) @@ -954,10 +955,6 @@ (->> (doseq [[?tfield ?member] (mapv vector (range (count ?members)) ?members)])))) )) -(defcompiler compile-import - [::&analyser/import ?class] - nil) - (defcompiler compile-use [::&analyser/use ?file ?alias] (let [module-name (re-find #"[^/]+$" ?file) @@ -1028,14 +1025,12 @@ (assert false (str "Can't compile: " (pr-str (:form state))))))) ;; [Interface] -(def !state (atom nil)) - -(defn compile [module-name inputs] - (if-let [module (get-in @!state [:modules module-name])] +(defn compile [state module-name inputs] + (if-let [module (get-in state [:modules module-name])] (assert false "Can't redefine a module!") (do (reset-loader!) (let [init-state (let [+prelude-module+ "lux" - init-state (assoc @!state :name module-name, :forms inputs, :defs-env {})] + init-state (assoc state :name module-name, :forms inputs, :defs-env {})] (if (= +prelude-module+ module-name) init-state (assoc init-state :defs-env (into {} (for [[?name ?desc] (get-in init-state [:modules +prelude-module+])] @@ -1055,15 +1050,14 @@ :parent nil} new-state (match ((exhaust-m (&analyser/with-scope module-name - (exec [ann-input &analyser/analyse-form + (exec [ann-input &analyser/analyse :let [_ (when (not (compile-form (assoc compiler-state :form ann-input))) (assert false ann-input))]] (return ann-input)))) init-state) [::&util/ok [?state ?forms]] (if (empty? (:forms ?state)) - (do (reset! !state ?state) - ?state) + ?state (assert false (str "Unconsumed input: " (pr-str (first (:forms ?state)))))) [::&util/failure ?message] @@ -1073,30 +1067,36 @@ (write-class module-name bytecode) (load-class! (string/replace module-name #"/" ".") (str module-name ".class")) bytecode) - new-state + [::&util/ok [new-state true]] )))) (defn compile-file [name] - (match ((&parser/parse-all) {::&lexer/source (slurp (str "source/" name ".lux"))}) - [::&util/ok [?state ?forms]] - (let [?forms* (filter identity ?forms)] - (prn '?forms ?forms*) - (compile name ?forms*)) + (fn [state] + (match ((&parser/parse-all) {::&lexer/source (slurp (str "source/" name ".lux"))}) + [::&util/ok [?state ?forms]] + (let [?forms* (filter identity ?forms)] + ;; (prn '?forms ?forms*) + (compile state name ?forms*)) - [::&util/failure ?message] - (assert false ?message))) + [::&util/failure ?message] + (fail* ?message)))) (defn compile-all [files] - (reset! !state {:name nil - :forms nil - :modules {} - :deps {} - :imports {} - :defs-env {} - :lambda-scope [[] 0] - :env (list (&analyser/fresh-env 0)) - :types &type/+init+}) - (dorun (map compile-file files))) + (let [state {:name nil + :forms nil + :modules {} + :deps {} + :imports {} + :defs-env {} + :lambda-scope [[] 0] + :env (list (&analyser/fresh-env 0)) + :types &type/+init+}] + (match ((do-all-m (map compile-file files)) state) + [::&util/ok [?state ?forms]] + (println (str "Compilation complete! " (pr-str files))) + + [::&util/failure ?message] + (assert false ?message)))) (comment (compile-all ["lux"]) diff --git a/src/lux/lexer.clj b/src/lux/lexer.clj index 78b9dc304..132f3402e 100644 --- a/src/lux/lexer.clj +++ b/src/lux/lexer.clj @@ -16,7 +16,7 @@ (return* (update-in state [::source] #(.substring % (.length match))) [tok1 tok2]) (fail* (str "[Lexer Error] Pattern failed: " regex))))) -(defn ^:private lex-str [prefix] +(defn ^:private lex-prefix [prefix] (fn [state] (if (.startsWith (::source state) prefix) (return* (update-in state [::source] #(.substring % (.length prefix))) prefix) @@ -34,10 +34,10 @@ ;; else (fail (str "[Lexer Error] Unknown escape character: " escaped)))) -(def ^:private lex-string-body +(def ^:private lex-text-body (try-all-m [(exec [[prefix escaped] (lex-regex2 #"(?s)^([^\"\\]*)(\\.)") unescaped (escape-char escaped) - postfix lex-string-body] + postfix lex-text-body] (return (str prefix unescaped postfix))) (lex-regex #"(?s)^([^\"\\]*)")])) @@ -48,6 +48,26 @@ (exec [white-space (lex-regex #"^(\s+)")] (return [::white-space white-space]))) +(def ^:private lex-single-line-comment + (exec [_ (lex-prefix "##") + comment (lex-regex #"^([^\n]*)") + _ (lex-regex #"^(\n?)")] + (return [::comment comment]))) + +(def ^:private lex-multi-line-comment + (exec [_ (lex-prefix "#(") + comment (try-all-m [(lex-regex #"(?is)^((?!#\().)*?(?=\)#)") + (exec [pre (lex-regex #"(?is)^(.+?(?=#\())") + [_ inner] lex-multi-line-comment + post (lex-regex #"(?is)^(.+?(?=\)#))")] + (return (str pre "#(" inner ")#" post)))]) + _ (lex-prefix ")#")] + (return [::comment comment]))) + +(def ^:private lex-comment + (try-all-m [lex-single-line-comment + lex-multi-line-comment])) + (do-template [<name> <tag> <regex>] (def <name> (exec [token (lex-regex <regex>)] @@ -59,47 +79,27 @@ ^:private lex-ident ::ident +ident-re+) (def ^:private lex-char - (exec [_ (lex-str "#\"") + (exec [_ (lex-prefix "#\"") token (try-all-m [(exec [escaped (lex-regex #"^(\\.)")] (escape-char escaped)) (lex-regex #"^(.)")]) - _ (lex-str "\"")] + _ (lex-prefix "\"")] (return [::char token]))) (def ^:private lex-text - (exec [_ (lex-str "\"") - token lex-string-body - _ (lex-str "\"")] + (exec [_ (lex-prefix "\"") + token lex-text-body + _ (lex-prefix "\"")] (return [::text token]))) -(def ^:private lex-single-line-comment - (exec [_ (lex-str "##") - comment (lex-regex #"^([^\n]*)") - _ (lex-regex #"^(\n?)")] - (return [::comment comment]))) - -(def ^:private lex-multi-line-comment - (exec [_ (lex-str "#(") - comment (try-all-m [(lex-regex #"(?is)^((?!#\().)*?(?=\)#)") - (exec [pre (lex-regex #"(?is)^(.+?(?=#\())") - [_ inner] lex-multi-line-comment - post (lex-regex #"(?is)^(.+?(?=\)#))")] - (return (str pre "#(" inner ")#" post)))]) - _ (lex-str ")#")] - (return [::comment comment]))) - -(def ^:private lex-comment - (try-all-m [lex-single-line-comment - lex-multi-line-comment])) - (def ^:private lex-tag - (exec [_ (lex-str "#") + (exec [_ (lex-prefix "#") token (lex-regex +ident-re+)] (return [::tag token]))) (do-template [<name> <text> <tag>] (def <name> - (exec [_ (lex-str <text>)] + (exec [_ (lex-prefix <text>)] (return [<tag>]))) ^:private lex-open-paren "(" ::open-paren @@ -121,6 +121,7 @@ ;; [Interface] (def lex (try-all-m [lex-white-space + lex-comment lex-bool lex-real lex-int @@ -128,5 +129,4 @@ lex-text lex-ident lex-tag - lex-comment lex-delimiter])) diff --git a/src/lux/parser.clj b/src/lux/parser.clj index e3a5a08a9..92d6d43b9 100644 --- a/src/lux/parser.clj +++ b/src/lux/parser.clj @@ -1,76 +1,26 @@ (ns lux.parser (:require [clojure.template :refer [do-template]] [clojure.core.match :refer [match]] - (lux [util :as &util :refer [exec return* return fail fail* - repeat-m try-m try-all-m map-m - apply-m]] + (lux [util :as &util :refer [exec return fail repeat-m]] [lexer :as &lexer]))) -(declare parse) - ;; [Utils] -(defmacro ^:private defparser [name match return] - `(defn ~name [token#] - (match token# - ~match - ~return - - _# - (fail (str "[Parser Error] Unmatched token: " token#))))) - -;; [Parsers] -(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 parse-comment - [::&lexer/comment _] - (return nil)) - -(defparser parse-whitespace - [::&lexer/white-space _] - (return nil)) - -(defparser ^:private parse-tag - [::&lexer/tag ?tag] - (return [::tag ?tag])) - -(defparser ^:private parse-form - [::&lexer/open-paren] - (exec [elems (repeat-m parse) - token &lexer/lex] - (if (= [::&lexer/close-paren] token) - (return [::form (filter identity elems)]) - (fail "[Parser Error] Unbalanced parantheses.")))) - -(do-template [<name> <open-tag> <close-tag> <description> <ast>] - (defparser <name> - [<open-tag>] +(do-template [<name> <close-token> <description> <ast>] + (defn <name> [parse] (exec [elems (repeat-m parse) token &lexer/lex] - (if (= [<close-tag>] token) - (return [<ast> (filter identity elems)]) + (if (= <close-token> token) + (return (list [<ast> (apply concat elems)])) (fail (str "[Parser Error] Unbalanced " <description> "."))))) - ^:private parse-form ::&lexer/open-paren ::&lexer/close-paren "parantheses" ::form - ^:private parse-tuple ::&lexer/open-bracket ::&lexer/close-bracket "brackets" ::tuple + ^:private parse-form [::&lexer/close-paren] "parantheses" ::form + ^:private parse-tuple [::&lexer/close-bracket] "brackets" ::tuple ) -(defparser ^:private parse-record - [::&lexer/open-brace] +(defn ^:private parse-record [parse] (exec [elems* (repeat-m parse) token &lexer/lex - :let [elems (filter identity elems*)]] + :let [elems (apply concat elems*)]] (cond (not= [::&lexer/close-brace] token) (fail (str "[Parser Error] Unbalanced braces.")) @@ -78,32 +28,47 @@ (fail (str "[Parser Error] Records must have an even number of elements.")) :else - (return [::record (filter identity elems)])))) - -(let [parsers [parse-comment - parse-whitespace - parse-bool - parse-int - parse-real - parse-char - parse-text - parse-tag - parse-ident - parse-form - parse-tuple - parse-record]] - (defn ^:private parse-token [token] - (try-all-m (map #(% token) parsers)))) - -(def ^:private parse + (return (list [::record elems]))))) + +;; [Interface] +(def parse (exec [token &lexer/lex] - (parse-token token))) - -(defn parse-all [] - (exec [ast parse] - (fn [state] - (if (empty? (::&lexer/source state)) - (return* state (if ast (list ast) '())) - ((exec [asts (parse-all)] - (return (cons ast asts))) - state))))) + (match token + [::&lexer/white-space _] + (return '()) + + [::&lexer/comment _] + (return '()) + + [::&lexer/bool ?value] + (return (list [::bool (Boolean/parseBoolean ?value)])) + + [::&lexer/int ?value] + (return (list [::int (Integer/parseInt ?value)])) + + [::&lexer/real ?value] + (return (list [::real (Float/parseFloat ?value)])) + + [::&lexer/char ?value] + (return (list [::char (.charAt ?value 0)])) + + [::&lexer/text ?value] + (return (list [::text ?value])) + + [::&lexer/ident ?value] + (return (list [::ident ?value])) + + [::&lexer/tag ?value] + (return (list [::tag ?value])) + + [::&lexer/open-paren] + (parse-form parse) + + [::&lexer/open-bracket] + (parse-tuple parse) + + [::&lexer/open-brace] + (parse-record parse) + + _ + (fail (str "[Parser Error] Unmatched token: " token))))) diff --git a/src/lux/util.clj b/src/lux/util.clj index 3662a4ea5..5d0d6ffc5 100644 --- a/src/lux/util.clj +++ b/src/lux/util.clj @@ -138,6 +138,20 @@ (fn [state] (return* state state))) +(defn do-all-m [monads] + (if (empty? monads) + (return '()) + (exec [head (first monads) + tail (do-all-m (rest monads))] + (return (cons head tail))))) + +(defn do-all-m* [monads] + (if (empty? monads) + (return '()) + (exec [head (first monads) + tail (do-all-m* (rest monads))] + (return (concat head tail))))) + (defn within [slot monad] (fn [state] (let [=return (monad (get state slot))] |