diff options
| -rw-r--r-- | src/lux/analyser.clj | 656 | ||||
| -rw-r--r-- | src/lux/analyser/base.clj | 32 | ||||
| -rw-r--r-- | src/lux/analyser/case.clj | 33 | ||||
| -rw-r--r-- | src/lux/analyser/env.clj | 80 | ||||
| -rw-r--r-- | src/lux/analyser/host.clj | 139 | ||||
| -rw-r--r-- | src/lux/analyser/lambda.clj | 158 | ||||
| -rw-r--r-- | src/lux/analyser/lux.clj | 142 | ||||
| -rw-r--r-- | src/lux/host.clj | 2 | ||||
| -rw-r--r-- | src/lux/type.clj | 2 | ||||
| -rw-r--r-- | src/lux/util.clj | 22 |
10 files changed, 667 insertions, 599 deletions
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index 0b9839968..de6058f50 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -1,716 +1,176 @@ (ns lux.analyser (:require (clojure [template :refer [do-template]]) [clojure.core.match :refer [match]] - (lux [util :as &util :refer [exec return* return fail fail* - repeat-m try-all-m map-m mapcat-m reduce-m - normalize-ident]] + (lux [util :as &util :refer [exec return fail + try-all-m map-m mapcat-m reduce-m + assert!]] [parser :as &parser] [type :as &type] [macro :as ¯o] - [host :as &host]))) - -;; [Util] -(def ^:private +dont-care-type+ [::&type/Any]) - -(defn ^:private annotate [module name access type] - (fn [state] - (let [full-name (str module &util/+name-separator+ name) - bound [::Expression [::global module name] type]] - [::&util/ok [(-> state - (assoc-in [::&util/modules module name] {:args-n [:None] - :access access - :type type - :defined? false}) - (update-in [::&util/global-env] merge {full-name bound, name bound})) - nil]]))) - -(defn ^:private declare-macro [module name] - (fn [state] - [::&util/ok [(assoc-in state [::&util/modules module :macros name] true) - nil]])) - -(defn ^:private expr-type [syntax+] - (match syntax+ - [::Expression _ type] - (return type) - - _ - (fail "Can't retrieve the type of a non-expression."))) - -(defn ^:private define [module name] - (exec [? annotated? - _ (assert! ? (str "[Analyser Error] Can't define an unannotated element: " name))] - (fn [state] - [::&util/ok [(assoc-in state [::&util/modules module name :defined?] true) - nil]]))) - -(defn ^:private defined? [module name] - (fn [state] - [::&util/ok [state (get-in state [::&util/modules module name :defined?])]])) - -(defn ^:private annotated? [module name] - (fn [state] - [::&util/ok [state (boolean (get-in state [::&util/modules module name]))]])) - -(defn ^:private macro? [module name] - (fn [state] - [::&util/ok [state (boolean (get-in state [::&util/modules module :macros name]))]])) - -(def ^:private next-local-idx - (fn [state] - [::&util/ok [state (-> state ::&util/local-envs first :locals :counter)]])) - -(defn ^:private with-env [label body] - (fn [state] - (let [=return (body (update-in state [::&util/local-envs] conj (fresh-env label)))] - (match =return - [::&util/ok [?state ?value]] - [::&util/ok [(update-in ?state [::&util/local-envs] rest) - ?value]] - - _ - =return)))) - -(defn ^:private with-local [name mode type body] - (fn [state] - (let [old-mappings (-> state ::&util/local-envs first (get-in [:locals :mappings])) - =return (body (update-in state [::&util/local-envs] - (fn [[top & stack]] - (let [bound-unit (case mode - :self [::self (list)] - :local [::local (get-in top [:locals :counter])])] - (cons (-> top - (update-in [:locals :counter] inc) - (assoc-in [:locals :mappings name] [::Expression bound-unit type])) - stack)))))] - (match =return - [::&util/ok [?state ?value]] - [::&util/ok [(update-in ?state [::&util/local-envs] (fn [[top* & stack*]] - (cons (-> top* - (update-in [:locals :counter] dec) - (assoc-in [:locals :mappings] old-mappings)) - stack*))) - ?value]] - - _ - =return)))) - -(defn ^:private with-locals [locals monad] - (reduce (fn [inner [label elem]] - (with-local label :local elem inner)) - monad - (reverse locals))) - -(def ^:private captured-vars - (fn [state] - [::&util/ok [state (-> state ::&util/local-envs first :closure :mappings)]])) - -(defn ^:private analyse-1 [elem] - (exec [output (analyse-ast elem)] - (match output - ([x] :seq) - (return x) - - :else - (fail "[Analyser Error] Can't expand to other than 1 element.")))) - -(defn ^:private analyse-2 [el1 el2] - (exec [output (mapcat-m analyse-ast (list el1 el2))] - (match output - ([x y] :seq) - (return [x y]) - - :else - (fail "[Analyser Error] Can't expand to other than 2 elements.")))) - -(defn ^:private with-lambda [self self-type arg arg-type body] - (fn [state] - (let [body* (with-env (-> state ::&util/local-envs first :inner-closures str) - (exec [$scope &util/get-scope] - (with-local self :self self-type - (with-local arg :local arg-type - (exec [=return body - =captured captured-vars] - (return [$scope =next =captured =return]))))))] - (body* (update-in state [::&util/local-envs] #(cons (update-in (first %) [:inner-closures] inc) - (rest %)))) - ))) - -(defn ^:private close-over [scope ident register frame] - (match register - [::Expression _ register-type] - (let [register* [::Expression [::captured scope (get-in frame [:closure :counter]) register] register-type]] - [register* (update-in frame [:closure] #(-> % - (update-in [:counter] inc) - (assoc-in [:mappings ident] register*)))]))) - -(defn ^:private extract-ident [ident] - (match ident - [::&parser/ident ?ident] - (return ?ident) - - _ - (fail ""))) - -(defn ^:private analyse-tuple [analyse-ast ?elems] - (exec [=elems (mapcat-m analyse-ast ?elems) - =elems-types (map-m expr-type =elems) - ;; :let [_ (prn 'analyse-tuple =elems)] - ] - (return (list [::Expression [::tuple =elems] [::&type/Tuple =elems-types]])))) - -(defn ^:private analyse-ident [analyse-ast ident] - (fn [state] - (let [[top & stack*] (::local-envs state)] - (if-let [=bound (or (get-in top [:locals :mappings ident]) - (get-in top [:closure :mappings ident]))] - [::&util/ok [state (list =bound)]] - (let [no-binding? #(and (-> % :locals :mappings (contains? ident) not) - (-> % :closure :mappings (contains? ident) not)) - [inner outer] (split-with no-binding? stack*)] - (if (empty? outer) - (if-let [global (get-in state [::&util/global-env ident])] - [::&util/ok [state (list global)]] - [::&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)])) - [(or (get-in (first outer) [:locals :mappings ident]) - (get-in (first outer) [:closure :mappings ident])) - '()] - (reverse (cons top inner)))] - [::&util/ok [(assoc state ::&util/local-envs (concat inner* outer)) (list =local)]]) - )) - )) - )) - -(defn ^:private analyse-call [analyse-ast ?fn ?args] - (exec [=fn (analyse-1 ?fn) - loader &util/loader] - (match =fn - [::Expression =fn-form =fn-type] - (match =fn-form - [::global ?module ?name] - (exec [macro? (macro? ?module ?name)] - (if macro? - (let [macro-class (&host/location (list ?name ?module)) - [macro-expansion state*] (¯o/expand loader macro-class ?args)] - (mapcat-m analyse-ast macro-expansion)) - (exec [=args (mapcat-m analyse-ast ?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 +dont-care-type+])))]] - (return (list [::Expression [::static-call needs-num =fn =args] =return-type]))))) - - _ - (exec [=args (mapcat-m analyse-ast ?args)] - (return (list [::Expression [::call =fn =args] +dont-care-type+])))) - - :else - (fail "Can't call something without a type.")) - )) - -(defn ^:private analyse-do [analyse-ast ?exprs] - (exec [_ (assert! (count ?exprs) "\"do\" expressions can't have empty bodies.") - =exprs (mapcat-m analyse-ast ?exprs) - =exprs-types (map-m expr-type =exprs)] - (return (list [::Expression [::do =exprs] (last =exprs-types)])))) - -(defn ^:private locals [member] - (match member - [::&parser/Ident ?name] - (list ?name) - - [::&parser/Tuple ?submembers] - (mapcat locals ?submembers) - - [::&parser/Form ([[::&parser/Tag _] & ?submembers] :seq)] - (mapcat locals ?submembers) - - _ - (list))) - -(defn ^:private analyse-branch [max-registers [bindings body]] - (reduce (fn [body* name] - (with-local name :local +dont-care-type+ body*)) - (reduce (fn [body* _] - (with-local "#" :local +dont-care-type+ body*)) - (analyse-1 body) - (range (- max-registers (count bindings)))) - bindings)) - -(defn ^:private analyse-case [analyse-ast ?variant ?branches] - (exec [=variant (analyse-1 ?variant) - _ (assert! (and (> (count ?branches) 0) (even? (count ?branches))) - "Unbalanced branches in \"case'\" expression.") - :let [branches (partition 2 ?branches) - locals-per-branch (map locals (map first branches)) - max-locals (reduce max 0 (map count locals-per-branch))] - base-register next-local-idx - =bodies (map-m (partial analyse-branch max-locals) - (map vector locals-per-branch (map second branches))) - =body-types (map-m expr-type =bodies) - =case-type (reduce-m &type/merge [::&type/Nothing] =body-types) - :let [=branches (map vector (map first branches) =bodies)]] - (return (list [::Expression [::case =variant base-register max-locals =branches] =case-type])))) - -(defn ^:private raise-expr [arg syntax] - (match syntax - [::Expression ?form ?type] - (match ?form - [::bool ?value] - syntax - - [::int ?value] - syntax - - [::real ?value] - syntax - - [::char ?value] - syntax - - [::text ?value] - syntax - - [::tuple ?members] - [::Expression [::tuple (map (partial raise-expr arg) ?members)] ?type] - - [::variant ?tag ?members] - [::Expression [::variant ?tag (map (partial raise-expr arg) ?members)] ?type] - - [::local ?idx] - [::Expression [::local (inc ?idx)] ?type] - - [::captured _ _ ?source] - ?source - - [::self ?curried] - [::Expression [::self (cons arg (map (partial raise-expr arg) ?curried))] ?type] - - [::global _ _] - syntax - - [::case ?variant ?base ?num-bindings ?pm-struct] - ... - - [::lambda ?scope ?captured ?args ?value] - [::Expression [::lambda (pop ?scope) - (into {} (for [[?name ?sub-syntax] ?captured] - [?name (raise-expr arg ?sub-syntax)])) - ?args - ?value] - ?type] - - [::call ?func ?args] - [::Expression [::call (raise-expr arg ?func) (map (partial raise-expr arg) ?args)] ?type] - - [::do ?asts] - [::Expression [::do (map (partial raise-expr 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)] - ?type] - - ;; Integer arithmetic - [::jvm-iadd ?x ?y] - [::Expression [::jvm-iadd (raise-expr arg ?x) (raise-expr arg ?y)] ?type] - - [::jvm-isub ?x ?y] - [::Expression [::jvm-isub (raise-expr arg ?x) (raise-expr arg ?y)] ?type] - - [::jvm-imul ?x ?y] - [::Expression [::jvm-imul (raise-expr arg ?x) (raise-expr arg ?y)] ?type] - - [::jvm-idiv ?x ?y] - [::Expression [::jvm-idiv (raise-expr arg ?x) (raise-expr arg ?y)] ?type] - - [::jvm-irem ?x ?y] - [::Expression [::jvm-irem (raise-expr arg ?x) (raise-expr arg ?y)] ?type] - - ;; Long arithmetic - [::jvm-ladd ?x ?y] - [::Expression [::jvm-ladd (raise-expr arg ?x) (raise-expr arg ?y)] ?type] - - [::jvm-lsub ?x ?y] - [::Expression [::jvm-lsub (raise-expr arg ?x) (raise-expr arg ?y)] ?type] - - [::jvm-lmul ?x ?y] - [::Expression [::jvm-lmul (raise-expr arg ?x) (raise-expr arg ?y)] ?type] - - [::jvm-ldiv ?x ?y] - [::Expression [::jvm-ldiv (raise-expr arg ?x) (raise-expr arg ?y)] ?type] - - [::jvm-lrem ?x ?y] - [::Expression [::jvm-lrem (raise-expr arg ?x) (raise-expr arg ?y)] ?type] - - ;; Float arithmetic - [::jvm-fadd ?x ?y] - [::Expression [::jvm-fadd (raise-expr arg ?x) (raise-expr arg ?y)] ?type] - - [::jvm-fsub ?x ?y] - [::Expression [::jvm-fsub (raise-expr arg ?x) (raise-expr arg ?y)] ?type] - - [::jvm-fmul ?x ?y] - [::Expression [::jvm-fmul (raise-expr arg ?x) (raise-expr arg ?y)] ?type] - - [::jvm-fdiv ?x ?y] - [::Expression [::jvm-fdiv (raise-expr arg ?x) (raise-expr arg ?y)] ?type] - - [::jvm-frem ?x ?y] - [::Expression [::jvm-frem (raise-expr arg ?x) (raise-expr arg ?y)] ?type] - - ;; Double arithmetic - [::jvm-dadd ?x ?y] - [::Expression [::jvm-dadd (raise-expr arg ?x) (raise-expr arg ?y)] ?type] - - [::jvm-dsub ?x ?y] - [::Expression [::jvm-dsub (raise-expr arg ?x) (raise-expr arg ?y)] ?type] - - [::jvm-dmul ?x ?y] - [::Expression [::jvm-dmul (raise-expr arg ?x) (raise-expr arg ?y)] ?type] - - [::jvm-ddiv ?x ?y] - [::Expression [::jvm-ddiv (raise-expr arg ?x) (raise-expr arg ?y)] ?type] - - [::jvm-drem ?x ?y] - [::Expression [::jvm-drem (raise-expr arg ?x) (raise-expr arg ?y)] ?type] - - _ - (assert false syntax) - ))) - -(defn ^:private analyse-lambda [analyse-ast ?self ?arg ?body] - (exec [[_ =arg =return :as =function] &type/fresh-function - [=scope =captured =body] (with-lambda ?self =function - ?arg =arg - (analyse-1 ?body)) - =body-type (expr-type =body) - =function (exec [_ (&type/solve =return =body-type)] - (&type/clean =function)) - :let [=lambda (match =body - [::Expression [::lambda ?sub-scope ?sub-captured ?sub-args ?sub-body] =body-type] - [::Expression [::lambda =scope =captured (cons ?arg ?sub-args) (raise-expr ?arg ?sub-body)] =body-type] - - _ - [::Expression [::lambda =scope =captured (list ?arg) =body] =body-type])]] - (return (list [::Expression =lambda =function])))) - -(defn ^:private analyse-def [analyse-ast ?name ?value] - ;; (prn 'analyse-def ?name ?value) - (exec [def?? (defined? ?name)] - (if def?? - (fail (str "Can't redefine " ?name)) - (exec [ann?? (annotated? ?name) - $module &util/get-module-name - =value (analyse-1 ?value) - =value (match =value - [::Expression =value-form =value-type] - (return (match =value-form - [::lambda ?old-scope ?env ?args ?body] - [::Expression [::lambda (list ?name $module) ?env ?args ?body] =value-type] - - _ - =value)) - - _ - (fail "")) - =value-type (expr-type =value) - _ (if ann?? - (return nil) - (annotate ?name ::public false =value-type)) - _ (define ?name)] - (return (list [::Statement [::def ?name =value]])))))) - -(defn ^:private analyse-declare-macro [?ident] - (exec [_ (annotate ?ident ::public true [::&type/Any])] - (return (list)))) - -(defn ^:private analyse-require [analyse-ast ?path] - (assert false) - (return (list))) - -(do-template [<name> <ident> <output-tag> <wrapper-class>] - (defn <name> [analyse-ast ?x ?y] - (exec [:let [=type [::&type/Data <wrapper-class>]] - [=x =y] (analyse-2 ?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])))) - - ^:private analyse-jvm-iadd "jvm;iadd" ::jvm-iadd "java.lang.Integer" - ^:private analyse-jvm-isub "jvm;isub" ::jvm-isub "java.lang.Integer" - ^:private analyse-jvm-imul "jvm;imul" ::jvm-imul "java.lang.Integer" - ^:private analyse-jvm-idiv "jvm;idiv" ::jvm-idiv "java.lang.Integer" - ^:private analyse-jvm-irem "jvm;irem" ::jvm-irem "java.lang.Integer" - - ^:private analyse-jvm-ladd "jvm;ladd" ::jvm-ladd "java.lang.Long" - ^:private analyse-jvm-lsub "jvm;lsub" ::jvm-lsub "java.lang.Long" - ^:private analyse-jvm-lmul "jvm;lmul" ::jvm-lmul "java.lang.Long" - ^:private analyse-jvm-ldiv "jvm;ldiv" ::jvm-ldiv "java.lang.Long" - ^:private analyse-jvm-lrem "jvm;lrem" ::jvm-lrem "java.lang.Long" - - ^:private analyse-jvm-iadd "jvm;fadd" ::jvm-fadd "java.lang.Float" - ^:private analyse-jvm-isub "jvm;fsub" ::jvm-fsub "java.lang.Float" - ^:private analyse-jvm-imul "jvm;fmul" ::jvm-fmul "java.lang.Float" - ^:private analyse-jvm-idiv "jvm;fdiv" ::jvm-fdiv "java.lang.Float" - ^:private analyse-jvm-irem "jvm;frem" ::jvm-frem "java.lang.Float" - - ^:private analyse-jvm-iadd "jvm;dadd" ::jvm-dadd "java.lang.Double" - ^:private analyse-jvm-isub "jvm;dsub" ::jvm-dsub "java.lang.Double" - ^:private analyse-jvm-imul "jvm;dmul" ::jvm-dmul "java.lang.Double" - ^:private analyse-jvm-idiv "jvm;ddiv" ::jvm-ddiv "java.lang.Double" - ^:private analyse-jvm-irem "jvm;drem" ::jvm-drem "java.lang.Double" - ) - -(defn ^:private analyse-jvm-getstatic [analyse-ast ?class ?field] - (exec [=class (full-class-name ?class) - =type (lookup-static-field =class ?field)] - (return (list [::Expression [::jvm-getstatic =class ?field] =type])))) - -(defn ^:private analyse-jvm-getfield [analyse-ast ?class ?field ?object] - (exec [=class (full-class-name ?class) - =type (lookup-static-field =class ?field) - =object (analyse-1 ?object)] - (return (list [::Expression [::jvm-getfield =class ?field =object] =type])))) - -(defn ^:private analyse-jvm-invokestatic [analyse-ast ?class ?method ?classes ?args] - (exec [=class (full-class-name ?class) - =classes (map-m extract-jvm-param ?classes) - =return (lookup-virtual-method =class ?method =classes) - =args (mapcat-m analyse-ast ?args)] - (return (list [::Expression [::jvm-invokestatic =class ?method =classes =args] =return])))) - -(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 ?method =classes) - =object (analyse-1 ?object) - =args (mapcat-m analyse-ast ?args)] - (return (list [::Expression [::jvm-invokevirtual =class ?method =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 (mapcat-m analyse-ast ?args)] - (return (list [::Expression [::jvm-new =class =classes =args] [::&type/Data =class]])))) - -(defn ^:private analyse-jvm-new-array [analyse-ast ?class ?length] - (exec [=class (full-class-name ?class)] - (return (list [::Expression [::jvm-new-array =class ?length] [::&type/Array [::&type/Data =class]]])))) - -(defn ^:private analyse-jvm-aastore [analyse-ast ?array ?idx ?elem] - (exec [[=array =elem] (analyse-2 ?array ?elem) - =array-type (expr-type =array)] - (return (list [::Expression [::jvm-aastore =array ?idx =elem] =array-type])))) - -(defn ^:private analyse-jvm-aaload [analyse-ast ?array ?idx] - (exec [=array (analyse-1 ?array) - =array-type (expr-type =array)] - (return (list [::Expression [::jvm-aaload =array ?idx] =array-type])))) - -(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)] - (return [?class ?field-name]) - - _ - (fail ""))) - ?fields) - :let [=fields (into {} (for [[class field] ?fields] - [field {:access :public - :type class}]))] - $module &util/get-module-name] - (return (list [::Statement [::jvm-class [$module ?name] ?super-class =fields {}]])))) - -(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)]] - :seq)] - (exec [?inputs (map-m extract-ident ?inputs)] - (return [?member-name [?inputs ?output]])) - - _ - (fail "")) - ?members) - :let [=methods (into {} (for [[method [inputs output]] ?members] - [method {:access :public - :type [inputs output]}]))] - $module &util/get-module-name] - (return (list [::Statement [::jvm-interface [$module ?name] {} =methods]])))) + [host :as &host]) + (lux.analyser [base :as &] + [lux :as &&lux] + [host :as &&host]))) +;; [Utils] (defn ^:private analyse-basic-ast [analyse-ast token] (match token ;; Standard special forms [::&parser/bool ?value] - (return (list [::Expression [::bool ?value] [::&type/Data "java.lang.Boolean"]])) + (return (list [::&/Expression [::bool ?value] [::&type/Data "java.lang.Boolean"]])) [::&parser/int ?value] - (return (list [::Expression [::int ?value] [::&type/Data "java.lang.Long"]])) + (return (list [::&/Expression [::int ?value] [::&type/Data "java.lang.Long"]])) [::&parser/real ?value] - (return (list [::Expression [::real ?value] [::&type/Data "java.lang.Double"]])) + (return (list [::&/Expression [::real ?value] [::&type/Data "java.lang.Double"]])) [::&parser/char ?value] - (return (list [::Expression [::char ?value] [::&type/Data "java.lang.Character"]])) + (return (list [::&/Expression [::char ?value] [::&type/Data "java.lang.Character"]])) [::&parser/text ?value] - (return (list [::Expression [::text ?value] [::&type/Data "java.lang.String"]])) + (return (list [::&/Expression [::text ?value] [::&type/Data "java.lang.String"]])) [::&parser/tuple ?elems] - (analyse-tuple analyse-ast ?elems) + (&&lux/analyse-tuple analyse-ast ?elems) [::&parser/tag ?tag] - (return (list [::Expression [::variant ?tag (list)] [::&type/Variant {?tag [::&type/Tuple (list)]}]])) + (return (list [::&/Expression [::variant ?tag (list)] [::&type/Variant {?tag [::&type/Tuple (list)]}]])) [::&parser/ident ?ident] - (analyse-ident analyse-ast ?ident) + (&&lux/analyse-ident analyse-ast ?ident) [::&parser/form ([[::&parser/ident "case'"] ?variant & ?branches] :seq)] - (analyse-case analyse-ast ?variant ?branches) + (&&lux/analyse-case analyse-ast ?variant ?branches) [::&parser/form ([[::&parser/ident "lambda'"] [::&parser/ident ?self] [::&parser/ident ?arg] ?body] :seq)] - (analyse-lambda analyse-ast ?self ?arg ?body) + (&&lux/analyse-lambda analyse-ast ?self ?arg ?body) [::&parser/form ([[::&parser/ident "def'"] [::&parser/ident ?name] ?value] :seq)] - (analyse-def analyse-ast ?name ?value) + (&&lux/analyse-def analyse-ast ?name ?value) [::&parser/form ([[::&parser/ident "declare-macro"] [::&parser/ident ?ident]] :seq)] - (analyse-declare-macro ?ident) + (&&lux/analyse-declare-macro ?ident) [::&parser/form ([[::&parser/ident "require"] [::&parser/text ?path]] :seq)] - (analyse-require analyse-ast ?path) + (&&lux/analyse-require analyse-ast ?path) ;; Host special forms - [::&parser/form ([[::&parser/ident "do"] & ?exprs] :seq)] - (analyse-do analyse-ast ?exprs) + [::&parser/form ([[::&parser/ident "exec"] & ?exprs] :seq)] + (&&host/analyse-exec analyse-ast ?exprs) ;; Integer arithmetic [::&parser/form ([[::&parser/ident "jvm;iadd"] ?x ?y] :seq)] - (analyse-jvm-iadd analyse-ast ?x ?y) + (&&host/analyse-jvm-iadd analyse-ast ?x ?y) [::&parser/form ([[::&parser/ident "jvm;isub"] ?x ?y] :seq)] - (analyse-jvm-isub analyse-ast ?x ?y) + (&&host/analyse-jvm-isub analyse-ast ?x ?y) [::&parser/form ([[::&parser/ident "jvm;imul"] ?x ?y] :seq)] - (analyse-jvm-imul analyse-ast ?x ?y) + (&&host/analyse-jvm-imul analyse-ast ?x ?y) [::&parser/form ([[::&parser/ident "jvm;idiv"] ?x ?y] :seq)] - (analyse-jvm-idiv analyse-ast ?x ?y) + (&&host/analyse-jvm-idiv analyse-ast ?x ?y) [::&parser/form ([[::&parser/ident "jvm;irem"] ?x ?y] :seq)] - (analyse-jvm-irem analyse-ast ?x ?y) + (&&host/analyse-jvm-irem analyse-ast ?x ?y) ;; Long arithmetic [::&parser/form ([[::&parser/ident "jvm;ladd"] ?x ?y] :seq)] - (analyse-jvm-ladd analyse-ast ?x ?y) + (&&host/analyse-jvm-ladd analyse-ast ?x ?y) [::&parser/form ([[::&parser/ident "jvm;lsub"] ?x ?y] :seq)] - (analyse-jvm-lsub analyse-ast ?x ?y) + (&&host/analyse-jvm-lsub analyse-ast ?x ?y) [::&parser/form ([[::&parser/ident "jvm;lmul"] ?x ?y] :seq)] - (analyse-jvm-lmul analyse-ast ?x ?y) + (&&host/analyse-jvm-lmul analyse-ast ?x ?y) [::&parser/form ([[::&parser/ident "jvm;ldiv"] ?x ?y] :seq)] - (analyse-jvm-ldiv analyse-ast ?x ?y) + (&&host/analyse-jvm-ldiv analyse-ast ?x ?y) [::&parser/form ([[::&parser/ident "jvm;lrem"] ?x ?y] :seq)] - (analyse-jvm-lrem analyse-ast ?x ?y) + (&&host/analyse-jvm-lrem analyse-ast ?x ?y) ;; Float arithmetic [::&parser/form ([[::&parser/ident "jvm;fadd"] ?x ?y] :seq)] - (analyse-jvm-fadd analyse-ast ?x ?y) + (&&host/analyse-jvm-fadd analyse-ast ?x ?y) [::&parser/form ([[::&parser/ident "jvm;fsub"] ?x ?y] :seq)] - (analyse-jvm-fsub analyse-ast ?x ?y) + (&&host/analyse-jvm-fsub analyse-ast ?x ?y) [::&parser/form ([[::&parser/ident "jvm;fmul"] ?x ?y] :seq)] - (analyse-jvm-fmul analyse-ast ?x ?y) + (&&host/analyse-jvm-fmul analyse-ast ?x ?y) [::&parser/form ([[::&parser/ident "jvm;fdiv"] ?x ?y] :seq)] - (analyse-jvm-fdiv analyse-ast ?x ?y) + (&&host/analyse-jvm-fdiv analyse-ast ?x ?y) [::&parser/form ([[::&parser/ident "jvm;frem"] ?x ?y] :seq)] - (analyse-jvm-frem analyse-ast ?x ?y) + (&&host/analyse-jvm-frem analyse-ast ?x ?y) ;; Double arithmetic [::&parser/form ([[::&parser/ident "jvm;dadd"] ?x ?y] :seq)] - (analyse-jvm-dadd analyse-ast ?x ?y) + (&&host/analyse-jvm-dadd analyse-ast ?x ?y) [::&parser/form ([[::&parser/ident "jvm;dsub"] ?x ?y] :seq)] - (analyse-jvm-dsub analyse-ast ?x ?y) + (&&host/analyse-jvm-dsub analyse-ast ?x ?y) [::&parser/form ([[::&parser/ident "jvm;dmul"] ?x ?y] :seq)] - (analyse-jvm-dmul analyse-ast ?x ?y) + (&&host/analyse-jvm-dmul analyse-ast ?x ?y) [::&parser/form ([[::&parser/ident "jvm;ddiv"] ?x ?y] :seq)] - (analyse-jvm-ddiv analyse-ast ?x ?y) + (&&host/analyse-jvm-ddiv analyse-ast ?x ?y) [::&parser/form ([[::&parser/ident "jvm;drem"] ?x ?y] :seq)] - (analyse-jvm-drem analyse-ast ?x ?y) + (&&host/analyse-jvm-drem analyse-ast ?x ?y) [::&parser/form ([[::&parser/ident "jvm;getstatic"] [::&parser/ident ?class] [::&parser/ident ?field]] :seq)] - (analyse-jvm-getstatic analyse-ast ?class ?field) + (&&host/analyse-jvm-getstatic analyse-ast ?class ?field) [::&parser/form ([[::&parser/ident "jvm;getfield"] [::&parser/ident ?class] [::&parser/ident ?field] ?object] :seq)] - (analyse-jvm-getfield analyse-ast ?class ?field ?object) + (&&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)] - (analyse-jvm-invokestatic analyse-ast ?class ?method ?classes ?args) + (&&host/analyse-jvm-invokestatic analyse-ast ?class ?method ?classes ?args) [::&parser/form ([[::&parser/ident "jvm;invokevirtual"] [::&parser/ident ?class] [::&parser/text ?method] [::&parser/tuple ?classes] ?object [::&parser/tuple ?args]] :seq)] - (analyse-jvm-invokevirtual analyse-ast ?class ?method ?classes ?object ?args) + (&&host/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) + (&&host/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) + (&&host/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) + (&&host/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) + (&&host/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) + (&&host/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) + (&&host/analyse-jvm-interface analyse-ast ?name ?members) _ (fail (str "[Analyser Error] Unmatched token: " token)))) -(defn analyse-ast [token] - ;; (prn 'analyse-ast token) +(defn ^:private analyse-ast [token] (match token [::&parser/form ([[::&parser/tag ?tag] & ?data] :seq)] (exec [=data (mapcat-m analyse-ast ?data) - ;; :let [_ (prn 'analyse-ast/variant+ ?tag '=data =data)] - =data-types (map-m expr-type =data)] - (return (list [::Expression [::variant ?tag =data] [::&type/Variant {?tag [::&type/Tuple =data-types]}]]))) + =data-types (map-m &/expr-type =data)] + (return (list [::&/Expression [::variant ?tag =data] [::&type/Variant {?tag [::&type/Tuple =data-types]}]]))) [::&parser/form ([?fn & ?args] :seq)] - (try-all-m [(analyse-call analyse-ast ?fn ?args) + (try-all-m [(&&lux/analyse-call analyse-ast ?fn ?args) (analyse-basic-ast analyse-ast token)]) _ (analyse-basic-ast analyse-ast token))) +;; [Resources] (def analyse (exec [asts &parser/parse] (mapcat-m analyse-ast asts))) diff --git a/src/lux/analyser/base.clj b/src/lux/analyser/base.clj new file mode 100644 index 000000000..713b58f18 --- /dev/null +++ b/src/lux/analyser/base.clj @@ -0,0 +1,32 @@ +(ns lux.analyser.base + (:require [clojure.core.match :refer [match]] + (lux [util :as &util :refer [exec return fail + try-all-m map-m mapcat-m reduce-m + assert!]]))) + +;; [Resources] +(defn expr-type [syntax+] + (match syntax+ + [::Expression _ type] + (return type) + + _ + (fail "Can't retrieve the type of a non-expression."))) + +(defn analyse-1 [analyse elem] + (exec [output (analyse elem)] + (match output + ([x] :seq) + (return x) + + :else + (fail "[Analyser Error] Can't expand to other than 1 element.")))) + +(defn analyse-2 [analyse el1 el2] + (exec [output (mapcat-m analyse (list el1 el2))] + (match output + ([x y] :seq) + (return [x y]) + + :else + (fail "[Analyser Error] Can't expand to other than 2 elements.")))) diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj new file mode 100644 index 000000000..8a914ab70 --- /dev/null +++ b/src/lux/analyser/case.clj @@ -0,0 +1,33 @@ +(ns lux.analyser.case + (:require [clojure.core.match :refer [match]] + (lux [util :as &util :refer [exec return fail + try-all-m map-m mapcat-m reduce-m + assert!]] + [parser :as &parser] + [type :as &type]) + (lux.analyser [env :as &env]))) + +;; [Resources] +(defn locals [member] + (match member + [::&parser/Ident ?name] + (list ?name) + + [::&parser/Tuple ?submembers] + (mapcat locals ?submembers) + + [::&parser/Form ([[::&parser/Tag _] & ?submembers] :seq)] + (mapcat locals ?submembers) + + _ + (list))) + +(defn analyse-branch [analyse-1 max-registers [bindings body]] + (reduce (fn [body* name] + (&env/with-local name :local &type/+dont-care-type+ body*)) + (reduce (fn [body* _] + (&env/with-local "#" :local &type/+dont-care-type+ body*)) + (analyse-1 body) + (range (- max-registers (count bindings)))) + bindings)) + diff --git a/src/lux/analyser/env.clj b/src/lux/analyser/env.clj new file mode 100644 index 000000000..ef5620e77 --- /dev/null +++ b/src/lux/analyser/env.clj @@ -0,0 +1,80 @@ +(ns lux.analyser.env + (:require [clojure.core.match :refer [match]] + (lux [util :as &util :refer [exec return fail + try-all-m map-m mapcat-m reduce-m + assert!]]))) + +;; [Resources] +(def next-local-idx + (fn [state] + [::&util/ok [state (-> state ::&util/local-envs first :locals :counter)]])) + +(defn defined? [module name] + (fn [state] + [::&util/ok [state (get-in state [::&util/modules module name :defined?])]])) + +(defn annotated? [module name] + (fn [state] + [::&util/ok [state (boolean (get-in state [::&util/modules module name]))]])) + +(defn macro? [module name] + (fn [state] + [::&util/ok [state (boolean (get-in state [::&util/modules module :macros name]))]])) + +(defn annotate [module name access type] + (fn [state] + (let [full-name (str module &util/+name-separator+ name) + bound [::Expression [::global module name] type]] + [::&util/ok [(-> state + (assoc-in [::&util/modules module name] {:args-n [:None] + :access access + :type type + :defined? false}) + (update-in [::&util/global-env] merge {full-name bound, name bound})) + nil]]))) + +(defn declare-macro [module name] + (fn [state] + [::&util/ok [(assoc-in state [::&util/modules module :macros name] true) + nil]])) + +(defn define [module name] + (exec [? annotated? + _ (assert! ? (str "[Analyser Error] Can't define an unannotated element: " name))] + (fn [state] + [::&util/ok [(assoc-in state [::&util/modules module name :defined?] true) + nil]]))) + +(defn with-local [name mode type body] + (fn [state] + (let [old-mappings (-> state ::&util/local-envs first (get-in [:locals :mappings])) + =return (body (update-in state [::&util/local-envs] + (fn [[top & stack]] + (let [bound-unit (case mode + :self [::self (list)] + :local [::local (get-in top [:locals :counter])])] + (cons (-> top + (update-in [:locals :counter] inc) + (assoc-in [:locals :mappings name] [::Expression bound-unit type])) + stack)))))] + (match =return + [::&util/ok [?state ?value]] + [::&util/ok [(update-in ?state [::&util/local-envs] (fn [[top* & stack*]] + (cons (-> top* + (update-in [:locals :counter] dec) + (assoc-in [:locals :mappings] old-mappings)) + stack*))) + ?value]] + + _ + =return)))) + +(defn with-locals [locals monad] + (reduce (fn [inner [label elem]] + (with-local label :local elem inner)) + monad + (reverse locals))) + +(def captured-vars + (fn [state] + [::&util/ok [state (-> state ::&util/local-envs first :closure :mappings)]])) diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj new file mode 100644 index 000000000..d9804f9e8 --- /dev/null +++ b/src/lux/analyser/host.clj @@ -0,0 +1,139 @@ +(ns lux.analyser.host + (:require (clojure [template :refer [do-template]]) + [clojure.core.match :refer [match]] + (lux [util :as &util :refer [exec return fail + try-all-m map-m mapcat-m reduce-m + assert!]] + [parser :as &parser] + [type :as &type] + [host :as &host]) + (lux.analyser [base :as &]))) + +;; [Utils] +(defn ^:private extract-ident [ident] + (match ident + [::&parser/ident ?ident] + (return ?ident) + + _ + (fail ""))) + +;; [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])))) + + analyse-jvm-iadd "jvm;iadd" ::jvm-iadd "java.lang.Integer" + analyse-jvm-isub "jvm;isub" ::jvm-isub "java.lang.Integer" + analyse-jvm-imul "jvm;imul" ::jvm-imul "java.lang.Integer" + analyse-jvm-idiv "jvm;idiv" ::jvm-idiv "java.lang.Integer" + analyse-jvm-irem "jvm;irem" ::jvm-irem "java.lang.Integer" + + analyse-jvm-ladd "jvm;ladd" ::jvm-ladd "java.lang.Long" + analyse-jvm-lsub "jvm;lsub" ::jvm-lsub "java.lang.Long" + analyse-jvm-lmul "jvm;lmul" ::jvm-lmul "java.lang.Long" + analyse-jvm-ldiv "jvm;ldiv" ::jvm-ldiv "java.lang.Long" + analyse-jvm-lrem "jvm;lrem" ::jvm-lrem "java.lang.Long" + + analyse-jvm-fadd "jvm;fadd" ::jvm-fadd "java.lang.Float" + analyse-jvm-fsub "jvm;fsub" ::jvm-fsub "java.lang.Float" + analyse-jvm-fmul "jvm;fmul" ::jvm-fmul "java.lang.Float" + analyse-jvm-fdiv "jvm;fdiv" ::jvm-fdiv "java.lang.Float" + analyse-jvm-frem "jvm;frem" ::jvm-frem "java.lang.Float" + + analyse-jvm-dadd "jvm;dadd" ::jvm-dadd "java.lang.Double" + analyse-jvm-dsub "jvm;dsub" ::jvm-dsub "java.lang.Double" + analyse-jvm-dmul "jvm;dmul" ::jvm-dmul "java.lang.Double" + analyse-jvm-ddiv "jvm;ddiv" ::jvm-ddiv "java.lang.Double" + analyse-jvm-drem "jvm;drem" ::jvm-drem "java.lang.Double" + ) + +(defn analyse-jvm-getstatic [analyse ?class ?field] + (exec [=class (&host/full-class-name ?class) + =type (&host/lookup-static-field =class ?field)] + (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)] + (return (list [::&/Expression [::jvm-getfield =class ?field =object] =type])))) + +(defn analyse-jvm-invokestatic [analyse ?class ?method ?classes ?args] + (exec [=class (&host/full-class-name ?class) + =classes (map-m &host/extract-jvm-param ?classes) + =return (&host/lookup-virtual-method =class ?method =classes) + =args (mapcat-m analyse ?args)] + (return (list [::&/Expression [::jvm-invokestatic =class ?method =classes =args] =return])))) + +(defn analyse-jvm-invokevirtual [analyse ?class ?method ?classes ?object ?args] + (exec [=class (&host/full-class-name ?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)] + (return (list [::&/Expression [::jvm-invokevirtual =class ?method =classes =object =args] =return])))) + +(defn analyse-jvm-new [analyse ?class ?classes ?args] + (exec [=class (&host/full-class-name ?class) + =classes (map-m &host/extract-jvm-param ?classes) + =args (mapcat-m analyse ?args)] + (return (list [::&/Expression [::jvm-new =class =classes =args] [::&type/Data =class]])))) + +(defn analyse-jvm-new-array [analyse ?class ?length] + (exec [=class (&host/full-class-name ?class)] + (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) + =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) + =array-type (&/expr-type =array)] + (return (list [::&/Expression [::jvm-aaload =array ?idx] =array-type])))) + +(defn analyse-jvm-class [analyse ?name ?super-class ?fields] + (exec [?fields (map-m (fn [?field] + (match ?field + [::&parser/tuple ([[::&parser/ident ?class] [::&parser/ident ?field-name]] :seq)] + (return [?class ?field-name]) + + _ + (fail ""))) + ?fields) + :let [=fields (into {} (for [[class field] ?fields] + [field {:access :public + :type class}]))] + $module &util/get-module-name] + (return (list [::&/Statement [::jvm-class [$module ?name] ?super-class =fields {}]])))) + +(defn analyse-jvm-interface [analyse ?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)]] + :seq)] + (exec [?inputs (map-m extract-ident ?inputs)] + (return [?member-name [?inputs ?output]])) + + _ + (fail "")) + ?members) + :let [=methods (into {} (for [[method [inputs output]] ?members] + [method {:access :public + :type [inputs output]}]))] + $module &util/get-module-name] + (return (list [::&/Statement [::jvm-interface [$module ?name] {} =methods]])))) + +(defn analyse-exec [analyse ?exprs] + (exec [_ (assert! (count ?exprs) "\"exec\" expressions can't have empty bodies.") + =exprs (mapcat-m analyse ?exprs) + =exprs-types (map-m &/expr-type =exprs)] + (return (list [::&/Expression [::do =exprs] (last =exprs-types)])))) diff --git a/src/lux/analyser/lambda.clj b/src/lux/analyser/lambda.clj new file mode 100644 index 000000000..2d08ee338 --- /dev/null +++ b/src/lux/analyser/lambda.clj @@ -0,0 +1,158 @@ +(ns lux.analyser.lambda + (:require [clojure.core.match :refer [match]] + (lux [util :as &util :refer [exec return fail + try-all-m map-m mapcat-m reduce-m + assert!]]) + (lux.analyser [env :as &env]))) + +;; [Resource] +(defn with-lambda [self self-type arg arg-type body] + (&util/with-closure + (exec [scope-name &util/get-scope-name] + (&env/with-local self :self self-type + (&env/with-local arg :local arg-type + (exec [=return body + =captured &env/captured-vars] + (return [scope-name =captured =return]))))))) + +(defn close-over [scope ident register frame] + (match register + [::Expression _ register-type] + (let [register* [::Expression [::captured scope (get-in frame [:closure :counter]) register] register-type]] + [register* (update-in frame [:closure] #(-> % + (update-in [:counter] inc) + (assoc-in [:mappings ident] register*)))]))) + +(defn raise-expr [arg syntax] + (match syntax + [::Expression ?form ?type] + (match ?form + [::bool ?value] + syntax + + [::int ?value] + syntax + + [::real ?value] + syntax + + [::char ?value] + syntax + + [::text ?value] + syntax + + [::tuple ?members] + [::Expression [::tuple (map (partial raise-expr arg) ?members)] ?type] + + [::variant ?tag ?members] + [::Expression [::variant ?tag (map (partial raise-expr arg) ?members)] ?type] + + [::local ?idx] + [::Expression [::local (inc ?idx)] ?type] + + [::captured _ _ ?source] + ?source + + [::self ?curried] + [::Expression [::self (cons arg (map (partial raise-expr arg) ?curried))] ?type] + + [::global _ _] + syntax + + [::case ?variant ?base ?num-bindings ?branches] + [::Expression [::case (raise-expr arg ?variant) (inc ?base) ?num-bindings + (for [[?pattern ?body] ?branches] + [?pattern (raise-expr arg ?body)])] + ?type] + + [::lambda ?scope ?captured ?args ?value] + [::Expression [::lambda (pop ?scope) + (into {} (for [[?name ?sub-syntax] ?captured] + [?name (raise-expr arg ?sub-syntax)])) + ?args + ?value] + ?type] + + [::call ?func ?args] + [::Expression [::call (raise-expr arg ?func) (map (partial raise-expr arg) ?args)] ?type] + + [::do ?asts] + [::Expression [::do (map (partial raise-expr 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)] + ?type] + + ;; Integer arithmetic + [::jvm-iadd ?x ?y] + [::Expression [::jvm-iadd (raise-expr arg ?x) (raise-expr arg ?y)] ?type] + + [::jvm-isub ?x ?y] + [::Expression [::jvm-isub (raise-expr arg ?x) (raise-expr arg ?y)] ?type] + + [::jvm-imul ?x ?y] + [::Expression [::jvm-imul (raise-expr arg ?x) (raise-expr arg ?y)] ?type] + + [::jvm-idiv ?x ?y] + [::Expression [::jvm-idiv (raise-expr arg ?x) (raise-expr arg ?y)] ?type] + + [::jvm-irem ?x ?y] + [::Expression [::jvm-irem (raise-expr arg ?x) (raise-expr arg ?y)] ?type] + + ;; Long arithmetic + [::jvm-ladd ?x ?y] + [::Expression [::jvm-ladd (raise-expr arg ?x) (raise-expr arg ?y)] ?type] + + [::jvm-lsub ?x ?y] + [::Expression [::jvm-lsub (raise-expr arg ?x) (raise-expr arg ?y)] ?type] + + [::jvm-lmul ?x ?y] + [::Expression [::jvm-lmul (raise-expr arg ?x) (raise-expr arg ?y)] ?type] + + [::jvm-ldiv ?x ?y] + [::Expression [::jvm-ldiv (raise-expr arg ?x) (raise-expr arg ?y)] ?type] + + [::jvm-lrem ?x ?y] + [::Expression [::jvm-lrem (raise-expr arg ?x) (raise-expr arg ?y)] ?type] + + ;; Float arithmetic + [::jvm-fadd ?x ?y] + [::Expression [::jvm-fadd (raise-expr arg ?x) (raise-expr arg ?y)] ?type] + + [::jvm-fsub ?x ?y] + [::Expression [::jvm-fsub (raise-expr arg ?x) (raise-expr arg ?y)] ?type] + + [::jvm-fmul ?x ?y] + [::Expression [::jvm-fmul (raise-expr arg ?x) (raise-expr arg ?y)] ?type] + + [::jvm-fdiv ?x ?y] + [::Expression [::jvm-fdiv (raise-expr arg ?x) (raise-expr arg ?y)] ?type] + + [::jvm-frem ?x ?y] + [::Expression [::jvm-frem (raise-expr arg ?x) (raise-expr arg ?y)] ?type] + + ;; Double arithmetic + [::jvm-dadd ?x ?y] + [::Expression [::jvm-dadd (raise-expr arg ?x) (raise-expr arg ?y)] ?type] + + [::jvm-dsub ?x ?y] + [::Expression [::jvm-dsub (raise-expr arg ?x) (raise-expr arg ?y)] ?type] + + [::jvm-dmul ?x ?y] + [::Expression [::jvm-dmul (raise-expr arg ?x) (raise-expr arg ?y)] ?type] + + [::jvm-ddiv ?x ?y] + [::Expression [::jvm-ddiv (raise-expr arg ?x) (raise-expr arg ?y)] ?type] + + [::jvm-drem ?x ?y] + [::Expression [::jvm-drem (raise-expr arg ?x) (raise-expr arg ?y)] ?type] + + _ + (assert false syntax) + ))) diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj new file mode 100644 index 000000000..b7aa46cee --- /dev/null +++ b/src/lux/analyser/lux.clj @@ -0,0 +1,142 @@ +(ns lux.analyser.lux + (:require (clojure [template :refer [do-template]]) + [clojure.core.match :refer [match]] + (lux [util :as &util :refer [exec return fail + try-all-m map-m mapcat-m reduce-m + assert!]] + [parser :as &parser] + [type :as &type] + [macro :as ¯o] + [host :as &host]) + (lux.analyser [base :as &] + [lambda :as &&lambda] + [case :as &&case] + [env :as &&env]))) + +;; [Resources] +(defn analyse-tuple [analyse ?elems] + (exec [=elems (mapcat-m analyse ?elems) + =elems-types (map-m &/expr-type =elems) + ;; :let [_ (prn 'analyse-tuple =elems)] + ] + (return (list [::&/Expression [::tuple =elems] [::&type/Tuple =elems-types]])))) + +(defn analyse-ident [analyse ident] + (fn [state] + (let [[top & stack*] (::local-envs state)] + (if-let [=bound (or (get-in top [:locals :mappings ident]) + (get-in top [:closure :mappings ident]))] + [::&util/ok [state (list =bound)]] + (let [no-binding? #(and (-> % :locals :mappings (contains? ident) not) + (-> % :closure :mappings (contains? ident) not)) + [inner outer] (split-with no-binding? stack*)] + (if (empty? outer) + (if-let [global (get-in state [::&util/global-env ident])] + [::&util/ok [state (list global)]] + [::&util/failure (str "[Analyser Error] Unresolved identifier: " ident)]) + (let [[=local inner*] (reduce (fn [[register new-inner] frame] + (let [[register* frame*] (&&lambda/close-over (:name frame) ident register frame)] + [register* (cons frame* new-inner)])) + [(or (get-in (first outer) [:locals :mappings ident]) + (get-in (first outer) [:closure :mappings ident])) + '()] + (reverse (cons top inner)))] + [::&util/ok [(assoc state ::&util/local-envs (concat inner* outer)) (list =local)]]) + )) + )) + )) + +(defn analyse-call [analyse ?fn ?args] + (exec [=fn (&/analyse-1 analyse ?fn) + loader &util/loader] + (match =fn + [::&/Expression =fn-form =fn-type] + (match =fn-form + [::global ?module ?name] + (exec [macro? (&&env/macro? ?module ?name)] + (if macro? + (let [macro-class (&host/location (list ?name ?module)) + [macro-expansion state*] (¯o/expand loader macro-class ?args)] + (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+])))) + + :else + (fail "Can't call something without a type.")) + )) + +(defn analyse-case [analyse ?variant ?branches] + (exec [=variant (&/analyse-1 analyse ?variant) + _ (assert! (and (> (count ?branches) 0) (even? (count ?branches))) + "Unbalanced branches in \"case'\" expression.") + :let [branches (partition 2 ?branches) + locals-per-branch (map &&case/locals (map first branches)) + max-locals (reduce max 0 (map count locals-per-branch))] + base-register &&env/next-local-idx + =bodies (map-m (partial &&case/analyse-branch &/analyse-1 max-locals) + (map vector locals-per-branch (map second branches))) + =body-types (map-m &/expr-type =bodies) + =case-type (reduce-m &type/merge [::&type/Nothing] =body-types) + :let [=branches (map vector (map first branches) =bodies)]] + (return (list [::&/Expression [::case =variant base-register max-locals =branches] =case-type])))) + +(defn analyse-lambda [analyse ?self ?arg ?body] + (exec [[_ =arg =return :as =function] &type/fresh-function + [=scope =captured =body] (&&lambda/with-lambda ?self =function + ?arg =arg + (&/analyse-1 analyse ?body)) + =body-type (&/expr-type =body) + =function (exec [_ (&type/solve =return =body-type)] + (&type/clean =function)) + :let [=lambda (match =body + [::&/Expression [::lambda ?sub-scope ?sub-captured ?sub-args ?sub-body] =body-type] + [::&/Expression [::lambda =scope =captured (cons ?arg ?sub-args) (&&lambda/raise-expr ?arg ?sub-body)] =body-type] + + _ + [::&/Expression [::lambda =scope =captured (list ?arg) =body] =body-type])]] + (return (list [::&/Expression =lambda =function])))) + +(defn analyse-def [analyse ?name ?value] + ;; (prn 'analyse-def ?name ?value) + (exec [def?? (&&env/defined? ?name)] + (if def?? + (fail (str "Can't redefine " ?name)) + (exec [ann?? (&&env/annotated? ?name) + $module &util/get-module-name + =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 ?name $module) ?env ?args ?body] =value-type] + + _ + =value)) + + _ + (fail "")) + =value-type (&/expr-type =value) + _ (if ann?? + (return nil) + (&&env/annotate ?name ::public false =value-type)) + _ (&&env/define ?name)] + (return (list [::&/Statement [::def ?name =value]])))))) + +(defn analyse-declare-macro [?ident] + (exec [_ (&&env/annotate ?ident ::public true [::&type/Any])] + (return (list)))) + +(defn analyse-require [analyse ?path] + (assert false) + (return (list))) diff --git a/src/lux/host.clj b/src/lux/host.clj index 2b9b1c725..56a29b093 100644 --- a/src/lux/host.clj +++ b/src/lux/host.clj @@ -97,4 +97,4 @@ ) (defn location [scope] - (->> scope reverse (map normalize-ident) (interpose "$") (reduce str ""))) + (->> scope (map normalize-ident) (interpose "$") (reduce str ""))) diff --git a/src/lux/type.clj b/src/lux/type.clj index 10d1171f4..bb22d343f 100644 --- a/src/lux/type.clj +++ b/src/lux/type.clj @@ -195,6 +195,8 @@ :else (fail (str "Can't merge types: " (pr-str x) " and " (pr-str y)))))) +(def +dont-care-type+ [::Any]) + (comment ;; Types [::Any] diff --git a/src/lux/util.clj b/src/lux/util.clj index 00c0fa6f0..3139cd20b 100644 --- a/src/lux/util.clj +++ b/src/lux/util.clj @@ -211,6 +211,24 @@ ::writer nil ::loader (class-loader!)}) +(defn ^:private with-scope [name body] + (fn [state] + (let [output (body (update-in state [::local-envs] conj (scope name)))] + (match output + [::ok [state* datum]] + [::ok [(update-in state* [::local-envs] rest) datum]] + + _ + output)))) + +(defn with-closure [body] + (fn [state] + (let [body* (with-scope (-> state ::local-envs first :inner-closures str) + body)] + (body* (update-in state [::local-envs] + #(cons (update-in (first %) [:inner-closures] inc) + (rest %))))))) + (do-template [<name> <tag>] (def <name> (fn [state] @@ -222,6 +240,10 @@ get-writer ::writer ) +(def get-scope-name + (fn [state] + [::ok [state (->> state ::local-envs (map :name) reverse (cons (::current-module state)))]])) + (defn with-writer [writer body] (fn [state] (let [output (body (assoc state ::writer writer))] |