diff options
Diffstat (limited to '')
| -rw-r--r-- | src/lux/analyser/lux.clj | 150 |
1 files changed, 78 insertions, 72 deletions
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index aa205bf06..e38d10117 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -2,7 +2,7 @@ (:require (clojure [template :refer [do-template]]) [clojure.core.match :as M :refer [matchv]] clojure.core.match.array - (lux [base :as & :refer [exec return return* fail fail* |let]] + (lux [base :as & :refer [exec return return* fail fail* |let |list]] [parser :as &parser] [type :as &type] [macro :as ¯o] @@ -13,15 +13,35 @@ [env :as &&env] [def :as &&def]))) -;; [Resources] -(defn analyse-tuple [analyse ?elems] - (exec [=elems (&/flat-map% analyse ?elems) +(defn ^:private analyse-1+ [analyse] + (fn [?token] + (&&/with-var #(&&/analyse-1 analyse % ?token)))) + +;; [Exports] +(defn analyse-tuple [analyse exo-type ?elems] + (exec [=elems (&/map% (analyse-1+ analyse) ?elems) =elems-types (&/map% &&/expr-type =elems) ;; :let [_ (prn 'analyse-tuple =elems)] + :let [endo-type (&/V "lux;TupleT" =elems-types)] + _ (&type/solve exo-type endo-type) + ;; :let [_ (prn 'analyse-tuple 'DONE)] ] - (return (&/|list (&/V "Expression" (&/T (&/V "tuple" =elems) (&/V "lux;TupleT" =elems-types))))))) + (return (&/|list (&/V "Expression" (&/T (&/V "tuple" =elems) + exo-type)))))) -(defn analyse-record [analyse ?elems] +(defn analyse-variant [analyse exo-type ident ?value] + (|let [[?module ?name] ident + ?tag (str ?module ";" ?name)] + (exec [=value ((analyse-1+ analyse) ?value) + =value-type (&&/expr-type =value) + :let [endo-type (&/V "lux;VariantT" (|list (&/T ?tag =value-type)))] + _ (&type/solve exo-type endo-type) + ;; :let [_ (prn 'analyse-variant 'DONE)] + ] + (return (&/|list (&/V "Expression" (&/T (&/V "variant" (&/T ?tag =value)) + exo-type))))))) + +(defn analyse-record [analyse exo-type ?elems] (exec [=elems (&/map% (fn [kv] (matchv ::M/objects [kv] [[k v]] @@ -38,19 +58,10 @@ ] (return (&/|list (&/V "Expression" (&/T (&/V "lux;record" =elems) (&/V "lux;RecordT" =elems-types))))))) -(defn ^:private resolve-global [ident state] - (|let [[?module ?name] ident - ident* (str ?module ";" ?name)] - (if-let [global (->> state (&/get$ "lux;global-env") &/from-some (&/get$ "lux;locals") (&/get$ "lux;mappings") (&/|get ident*))] - (return* state (&/|list global)) - (fail* (str "[Analyser Error] Unresolved identifier: " ident*))))) - -(defn analyse-ident [analyse ident] +(defn analyse-symbol [analyse exo-type ident] (|let [[?module ?name] ident] (do ;; (prn 'analyse-ident ?module ?name) - (exec [module-name &/get-module-name] - (if (not= module-name ?module) - (partial resolve-global ident) + (exec [module-name &/get-module-name] (fn [state] ;; (when (and (= "lux" ?module) ;; (= "output" ?name)) @@ -59,44 +70,40 @@ ;; (prn '(&/get$ "local-envs" state) (&/get$ "local-envs" state)) ;; (prn '(&/->seq (&/get$ "local-envs" state)) (&/->seq (&/get$ "local-envs" state))) ;; (println (&/show-state state)) - (let [stack (&/get$ "lux;local-envs" state)] - (matchv ::M/objects [stack] + (|let [stack (&/get$ "lux;local-envs" state) + no-binding? #(and (->> % (&/get$ "lux;locals") (&/get$ "lux;mappings") (&/|contains? ?name) not) + (->> % (&/get$ "lux;closure") (&/get$ "lux;mappings") (&/|contains? ?name) not)) + [inner outer] (&/|split-with no-binding? stack)] + (matchv ::M/objects [outer] [["lux;Nil" _]] - (resolve-global ident state) - - [["lux;Cons" [top stack*]]] - (if-let [=bound (or (->> stack &/|head (&/get$ "lux;locals") (&/get$ "lux;mappings") (&/|get ?name)) - (->> stack &/|head (&/get$ "lux;closure") (&/get$ "lux;mappings") (&/|get ?name)))] - (return* state (&/|list =bound)) - (|let [no-binding? #(and (->> % (&/get$ "lux;locals") (&/get$ "lux;mappings") (&/|contains? ?name) not) - (->> % (&/get$ "lux;closure") (&/get$ "lux;mappings") (&/|contains? ?name) not)) - [inner outer] (&/|split-with no-binding? stack*)] - (matchv ::M/objects [outer] - [["lux;Nil" _]] - (resolve-global ident state) - - [["lux;Cons" [top-outer _]]] - (|let [in-stack (&/|cons top inner) - scopes (&/|tail (&/folds #(&/|cons (&/get$ "lux;name" %2) %1) - (&/|map #(&/get$ "lux;name" %) outer) - (&/|reverse in-stack))) - ;; _ (prn 'in-stack module-name ident (&/->seq (&/|map #(&/get$ "name" %) in-stack)) scopes) - [=local inner*] (&/fold (fn [register+new-inner frame+in-scope] - (|let [[register new-inner] register+new-inner - [frame in-scope] frame+in-scope - [register* frame*] (&&lambda/close-over (&/|cons module-name (&/|reverse in-scope)) ?name register frame)] - (&/T register* (&/|cons frame* new-inner)))) - (&/T (or (->> top-outer (&/get$ "lux;locals") (&/get$ "lux;mappings") (&/|get ?name)) - (->> top-outer (&/get$ "lux;closure") (&/get$ "lux;mappings") (&/|get ?name))) - (&/|list)) - (&/zip2 (&/|reverse in-stack) scopes))] - (return* (&/set$ "lux;local-envs" (&/|++ inner* outer) state) (&/|list =local))) - ))) - )) - )) - )))) - -(defn ^:private analyse-apply* [analyse =fn ?args] + (|let [[?module ?name] ident + ident* (str ?module ";" ?name)] + (if-let [global (->> state (&/get$ "lux;global-env") &/from-some (&/get$ "lux;locals") (&/get$ "lux;mappings") (&/|get ident*))] + (&/run-state (exec [=global-type (&&/expr-type global) + _ (&type/solve exo-type =global-type)] + (return (&/|list global))) + state) + (fail* (str "[Analyser Error] Unresolved identifier: " ident*)))) + + [["lux;Cons" [top-outer _]]] + (|let [scopes (&/|tail (&/folds #(&/|cons (&/get$ "lux;name" %2) %1) + (&/|map #(&/get$ "lux;name" %) outer) + (&/|reverse inner))) + ;; _ (prn 'inner module-name ident (&/->seq (&/|map #(&/get$ "name" %) inner)) scopes) + [=local inner*] (&/fold (fn [register+new-inner frame+in-scope] + (|let [[register new-inner] register+new-inner + [frame in-scope] frame+in-scope + [register* frame*] (&&lambda/close-over (&/|cons module-name (&/|reverse in-scope)) ?name register frame)] + (&/T register* (&/|cons frame* new-inner)))) + (&/T (or (->> top-outer (&/get$ "lux;locals") (&/get$ "lux;mappings") (&/|get ?name)) + (->> top-outer (&/get$ "lux;closure") (&/get$ "lux;mappings") (&/|get ?name))) + (&/|list)) + (&/zip2 (&/|reverse inner) scopes))] + (return* (&/set$ "lux;local-envs" (&/|++ inner* outer) state) (&/|list =local))) + ))) + )))) + +(defn ^:private analyse-apply* [analyse exo-type =fn ?args] (exec [=args (&/flat-map% analyse ?args) =fn-type (&&/expr-type =fn) [=apply _] (&/fold% (fn [[=fn =fn-type] =input] @@ -113,7 +120,7 @@ =args)] (return (&/|list =apply)))) -(defn analyse-apply [analyse =fn ?args] +(defn analyse-apply [analyse exo-type =fn ?args] ;; (prn 'analyse-apply1 (aget =fn 0)) (exec [loader &/loader] (matchv ::M/objects [=fn] @@ -136,7 +143,7 @@ (fail "[Analyser Error] Can't call a statement!")) )) -(defn analyse-case [analyse ?value ?branches] +(defn analyse-case [analyse exo-type ?value ?branches] ;; (prn 'analyse-case (aget ?branches 0) (aget ?branches 1 1 0) ;; (&/->seq ?branches)) ;; (prn 'analyse-case (&/show-ast ?value)) @@ -160,12 +167,13 @@ ;; :let [_ (prn '=bodies =bodies)] ;; :let [_ (prn 'analyse-case/=bodies =bodies)] =body-types (&/map% &&/expr-type =bodies) + :let [_ (prn 'analyse-case (->> =body-types (&/|map &type/show-type) (&/|interpose " ") (&/fold str "")))] =case-type (&/fold% &type/merge (&/V "lux;NothingT" nil) =body-types) :let [=branches (&/zip2 (&/|map &/|first branches) =bodies)]] (return (&/|list (&/V "Expression" (&/T (&/V "case" (&/T =value base-register max-locals =branches)) =case-type)))))) -(defn analyse-lambda [analyse ?self ?arg ?body] +(defn analyse-lambda [analyse exo-type ?self ?arg ?body] ;; (prn 'analyse-lambda ?self ?arg ?body) (exec [=lambda-type* &type/fresh-lambda] (matchv ::M/objects [=lambda-type*] @@ -192,18 +200,21 @@ ] (return (&/|list (&/V "Expression" (&/T (&/V "lambda" (&/T =scope =captured ?arg =body)) =lambda-type)))))))) -(defn analyse-def [analyse ?name ?value] +(defn analyse-def [analyse exo-type ?name ?value] ;; (prn 'analyse-def ?name ?value) - (exec [module-name &/get-module-name] + (exec [_ (&type/solve &type/Nothing exo-type) + module-name &/get-module-name] (&/if% (&&def/defined? module-name ?name) (fail (str "[Analyser Error] Can't redefine " ?name)) (exec [=value (&/with-scope ?name - (&&/analyse-1 analyse ?value)) + (&&/with-var + #(&&/analyse-1 analyse % ?value))) =value-type (&&/expr-type =value) + :let [_ (prn 'analyse-def ?name (&type/show-type =value-type))] _ (&&def/define module-name ?name =value-type)] (return (&/|list (&/V "Statement" (&/V "def" (&/T ?name =value))))))))) -(defn analyse-declare-macro [ident] +(defn analyse-declare-macro [exo-type ident] (|let [[?module ?name] ident] (exec [module-name &/get-module-name] (if (= ?module module-name) @@ -211,23 +222,18 @@ (return (&/|list))) (fail "Can't declare macros from foreign modules."))))) -(defn analyse-import [analyse ?path] +(defn analyse-import [analyse exo-type ?path] (assert false) (return (&/|list))) -(defn analyse-check [analyse eval! ?type ?value] +(defn analyse-check [analyse eval! exo-type ?type ?value] (println "analyse-check#0") - (exec [=type (&&/analyse-1 analyse ?type) + (exec [=type (&&/analyse-1 analyse &type/Type ?type) :let [_ (println "analyse-check#1")] - =type-type (&&/expr-type =type) - :let [_ (println "analyse-check#2") - _ (println 1 (&type/show-type &type/Type)) - _ (println 2 (&type/show-type =type-type))] - _ (&type/solve &type/init-fixpoints &type/Type =type-type) - :let [_ (println "analyse-check#3")] ==type (eval! =type) + _ (&type/solve &type/init-fixpoints exo-type ==type) :let [_ (println "analyse-check#4" (&type/show-type ==type))] - =value (&&/analyse-1 analyse ?value) + =value (&&/analyse-1 analyse ==type ?value) :let [_ (println "analyse-check#5")]] (matchv ::M/objects [=value] [["Expression" [?expr ?expr-type]]] @@ -236,7 +242,7 @@ :let [_ (println "analyse-check#7")]] (return (&/|list (&/V "Expression" (&/T ?expr ==type)))))))) -(defn analyse-coerce [analyse eval! ?type ?value] +(defn analyse-coerce [analyse eval! exo-type ?type ?value] (exec [=type (&&/analyse-1 analyse ?type) =type-type (&&/expr-type =type) _ (&type/solve &type/init-fixpoints &type/Type =type-type) |