(ns lang.analyser (:refer-clojure :exclude [resolve]) (:require (clojure [string :as string] [template :refer [do-template]]) [clojure.core.match :refer [match]] (lang [util :as &util :refer [exec return* return fail fail* repeat-m try-m try-all-m map-m reduce-m apply-m within normalize-ident loader]] [parser :as &parser] [type :as &type]))) (declare analyse-form ->tokens tokens->clojure) ;; [Util] (defn ^:private annotated [form type] {:form form :type type}) (defn fresh-env [id] {:id id :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 [:defs (:name state) name] desc) (assoc-in [:defs-env name] (annotated [::global (:name state) name] (:type desc)))) nil]])) (defn ^:private is-macro? [name] (fn [state] ;; (prn 'is-macro? (nth name 1) ;; (get-in state [:defs (:name state) (nth name 1) :mode]) ;; (= (get-in state [:defs (:name state) (nth name 1) :mode]) ::macro)) [::&util/ok [state (= (get-in state [:defs (:name state) (nth name 1) :mode]) ::macro)]])) (def ^:private next-local-idx (fn [state] [::&util/ok [state (-> state :env first :counter)]])) (def ^:private scope-id (fn [state] [::&util/ok [state (-> state :env first :id)]])) (def ^:private my-frame (fn [state] [::&util/ok [state (-> state :env first)]])) (defn ^:private in-scope? [scope] (fn [state] (match scope [::&parser/ident ?macro-name] (do ;; (prn 'in-scope? ;; ?macro-name ;; (get-in state [:lambda-scope 0]) ;; (some (partial = ?macro-name) (get-in state [:lambda-scope 0]))) [::&util/ok [state (some (partial = ?macro-name) (get-in state [:lambda-scope 0]))]]) _ [::&util/ok [state false]]) )) (defn with-scope [scope body] (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)))) (defn ^:private with-scoped-name [name type body] (fn [state] (let [=return (body (update-in state [:env] #(cons (assoc-in (first %) [:mappings name] (annotated [::global (: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)))) (defn ^:private with-lambda-scope [body] (fn [state] (let [;; _ (prn 'with-lambda-scope (get-in state [:lambda-scope 0]) (get-in state [:lambda-scope 1])) =return (body (-> state (update-in [:lambda-scope 0] conj (get-in state [:lambda-scope 1])) (assoc-in [:lambda-scope 1] 0)))] (match =return [::&util/ok [?state ?value]] [::&util/ok [(do ;; (prn [:lambda-scope 0] (get-in ?state [:lambda-scope 0])) ;; (prn [:lambda-scope 1] (get-in ?state [:lambda-scope 1])) (-> ?state (update-in [:lambda-scope 0] pop) (assoc-in [:lambda-scope 1] (inc (get-in state [:lambda-scope 1]))))) ?value]] _ =return)))) (def ^:private scope (fn [state] [::&util/ok [state (get-in state [:lambda-scope 0])]])) (defn ^:private with-local [name type 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 %))))] ;; =return (match =return [::&util/ok [?state ?value]] (do ;; (prn 'POST-WITH-LOCAL name (-> ?state :env first)) [::&util/ok [(update-in ?state [:env] #(cons (-> (first %) (update-in [:counter] dec) (update-in [:mappings] dissoc name)) (rest %))) ;; (update-in ?state [:env] (fn [[top & oframes]] ;; (prn 'NEW-FRAMES name (cons (-> state :env first (assoc :closure (-> top :closure))) oframes)) ;; (cons (-> state :env first (assoc :closure (-> top :closure))) oframes))) ?value]]) _ =return) ))) (defn ^:private with-locals [mappings monad] (fn [state] (let [=return (monad (update-in state [:env] #(cons (update-in (first %) [:mappings] merge mappings) (rest %))))] (match =return [::&util/ok [?state ?value]] (do ;; (prn 'POST-WITH-LOCAL name (-> ?state :env first)) [::&util/ok [(update-in ?state [:env] #(cons (assoc (first %) :mappings (-> state :env first :mappings)) (rest %))) ?value]]) _ =return)))) (defn ^:private with-fresh-env [[args-vars args-types] body] (with-lambda-scope (fn [state] ;; (prn '(:env state) (:env state) (-> state :env first :id inc)) (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*) ;; _ (prn '=return =return) ] (match =return [::&util/ok [?state ?value]] (do ;; (prn 'PRE-LAMBDA (:env state)) ;; (prn 'POST-LAMBDA (:env ?state) ?value) [::&util/ok [(-> ?state (update-in [:env] rest) ;; (update-in [:lambda-scope 1] inc) ) [(get-in ?state [:lambda-scope 0]) (-> ?state :env first) ?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]]))) (defn ^:private require-module [name alias] (fn [state] [::&util/ok [(assoc-in state [:deps alias] name) nil]])) (defn ^:private close-over [scope ident register frame] ;; (prn 'close-over scope ident register) (let [register* (annotated [::captured scope (:closure/id frame) register] (:type register))] [register* (-> frame (update-in [:closure/id] inc) (assoc-in [:mappings ident] register*))])) (defn ^:private resolve [ident] (fn [state] (if-let [[_ ?alias ?binding] (re-find #"^(.*)/(.*)$" ident)] (let [?module (get-in state [:deps ?alias])] ;; (prn 'resolve ?module ?alias ?binding) [::&util/ok [state (annotated [::global ?module ?binding] ::&type/nothing)]]) (let [;; _ (prn 'resolve/_1 ident) [inner outer] (split-with #(nil? (get-in % [:mappings ident])) (:env state)) ;; _ (prn ident '[inner outer] [inner outer]) ;; _ (prn 'resolve/_2 '[inner outer] [inner outer]) ] (cond (empty? inner) [::&util/ok [state (-> state :env first :mappings (get ident))]] (empty? outer) (if-let [global|import (or (get-in state [:defs-env ident]) (get-in state [:imports ident]))] (do ;; (prn 'resolve/_3 'global|import global|import) [::&util/ok [state global|import]]) [::&util/failure (str "Unresolved identifier: " ident)]) :else (let [[=local inner*] (reduce (fn [[register new-inner] [frame scope]] (let [[register* frame*] (close-over scope ident register frame)] [register* (cons frame* new-inner)])) [(-> outer first :mappings (get ident)) '()] (map vector (reverse inner) (->> (get-in state [:lambda-scope 0]) (iterate pop) (take (count inner)) reverse))) ;; _ (prn 'resolve/_4 '[=local inner*] =local inner*) ] [::&util/ok [(assoc state :env (concat inner* outer)) =local]]))) ))) (defmacro ^:private defanalyser [name match return] `(def ~name (fn [{[token# & left#] :forms :as state#}] (match token# ~match (~return (assoc state# :forms left#)) _# (fail* (str "Unmatched token: " token#)))))) (defn analyse-form* [form] ;; (prn 'analyse-form* form) (fn [state] (let [old-forms (:forms state) =return (analyse-form (assoc state :forms (list form))) ;; _ (prn 'analyse-form*/=return =return) ] (match =return [::&util/ok [?state ?value]] [::&util/ok [(assoc ?state :forms old-forms) ?value]] [::&util/failure ?message] (do (prn 'analyse-form* ?message) [::&util/failure ?message]))))) (do-template [ ] (defanalyser [ ?value] (return (annotated [::literal ?value] [::&type/object []]))) analyse-boolean ::&parser/boolean "java.lang.Boolean" analyse-int ::&parser/int "java.lang.Integer" analyse-float ::&parser/float "java.lang.Float" analyse-char ::&parser/char "java.lang.Character" analyse-string ::&parser/string "java.lang.String" ) (defanalyser analyse-variant [::&parser/variant ?tag ?data] (exec [;; :let [_ (prn 'analyse-variant [?tag ?value])] =data (map-m analyse-form* ?data) ;; :let [_ (prn '=value =value)] ] (return (annotated [::variant ?tag =data] [::&type/variant ?tag (map :type =data)])))) (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] ;; (exec [_env (fn [state] [::&util/ok [state (:env state)]]) ;; ;; :let [_ (prn 'analyse-ident ?ident _env)] ;; ] ;; (resolve ?ident)) (exec [;; :let [_ (prn 'analyse-ident '?ident ?ident)] =ident (resolve ?ident) ;; :let [_ (prn 'analyse-ident '=ident =ident)] ;; :let [_ (prn 'analyse-ident ?ident =ident)] ;; state &util/get-state ;; :let [_ (prn 'analyse-ident ?ident (:form =ident) (:env state))] ] (return =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))))) (defn extract-ident [ident] (match ident [::&parser/ident ?ident] (return ?ident) _ (fail ""))) (defn extract-class [x] (match x [::class ?class] (return ?class) _ (fail ""))) (defn class-type [x] (match x [::&type/object ?class []] (return ?class) _ (fail ""))) (defn lookup-field [mode target field] ;; (prn 'lookup-field mode target field) (if-let [[[owner type]] (seq (for [=field (.getFields (Class/forName target)) ;; :let [_ (prn target (.getName =field) (if (java.lang.reflect.Modifier/isStatic (.getModifiers =field)) ;; :static ;; :dynamic))] :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 "Field does not exist: " target field mode)))) (defn lookup-method [mode target method args] ;; (prn 'lookup-method mode target method args) (if-let [methods (seq (for [=method (.getMethods (Class/forName target)) ;; :let [_ (prn target (.getName =method) (if (java.lang.reflect.Modifier/isStatic (.getModifiers =method)) ;; :static ;; :dynamic))] :when (and (= method (.getName =method)) (case mode :static (java.lang.reflect.Modifier/isStatic (.getModifiers =method)) :dynamic (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 "Method does not exist: " target method mode)))) (defanalyser analyse-access [::&parser/access ?object ?member] (match ?member [::&parser/ident ?field] ;; Field (try-all-m [(exec [?target (extract-ident ?object) =target (resolve ?target) ?class (extract-class (:form =target)) [=owner =type] (lookup-field :static ?class ?field) ;; :let [_ (prn '=type =type)] ] (return (annotated [::static-field =owner ?field] =type))) (exec [=target (analyse-form* ?object) ?class (class-type (:type =target)) [=owner =type] (lookup-field :dynamic ?class ?field) ;; :let [_ (prn '=type =type)] ] (return (annotated [::dynamic-field =target =owner ?field] =type)))]) [::&parser/fn-call [::&parser/ident ?method] ?args] ;; Method (exec [=args (map-m analyse-form* ?args)] (try-all-m [(exec [?target (extract-ident ?object) =target (resolve ?target) ?class (extract-class (:form =target)) =methods (lookup-method :static ?class ?method (map :type =args)) ;; :let [_ (prn '=methods =methods)] [=owner =method] (within :types (&type/pick-matches =methods (map :type =args))) ;; :let [_ (prn '=method =owner ?method =method)] ] (return (annotated [::static-method =owner ?method =method =args] (&type/return-type =method)))) (exec [=target (analyse-form* ?object) ?class (class-type (:type =target)) =methods (lookup-method :dynamic ?class ?method (map :type =args)) ;; :let [_ (prn '=methods =methods)] [=owner =method] (within :types (&type/pick-matches =methods (map :type =args))) ;; :let [_ (prn '=method =owner ?method =method)] ] (return (annotated [::dynamic-method =target =owner ?method =method =args] (&type/return-type =method))))])))) (defn ->token [x] ;; (prn '->token x) (let [variant (.newInstance (.loadClass loader "test2.Variant"))] (match x [::&parser/string ?text] (doto variant (-> .-tag (set! "Text")) (-> .-value (set! (doto (.newInstance (.loadClass loader "test2.Tuple1")) (-> .-_0 (set! ?text)))))) [::&parser/ident ?ident] (doto variant (-> .-tag (set! "Ident")) (-> .-value (set! (doto (.newInstance (.loadClass loader "test2.Tuple1")) (-> .-_0 (set! ?ident)))))) [::&parser/fn-call ?fn ?args] (doto variant (-> .-tag (set! "Form")) (-> .-value (set! (doto (.newInstance (.loadClass loader "test2.Tuple1")) (-> .-_0 (set! (->tokens (cons ?fn ?args)))))) )) ))) (defn ->tokens [xs] (let [variant (.loadClass loader "test2.Variant") tuple2 (.loadClass loader "test2.Tuple2")] (reduce (fn [tail x] ;; (prn 'tail (.-tag tail) 'x x) (doto (.newInstance variant) (-> .-tag (set! "Cons")) (-> .-value (set! (doto (.newInstance tuple2) (-> .-_0 (set! (->token x))) (-> .-_1 (set! tail)) ;; (-> prn) ))) ;; (-> prn) )) (doto (.newInstance variant) (-> .-tag (set! "Nil")) (-> .-value (set! (.newInstance (.loadClass loader "test2.Tuple0"))))) (reverse xs)))) (defn ->clojure-token [x] ;; (prn '->clojure-token x (.-tag x)) (case (.-tag x) "Text" [::&parser/string (-> x .-value .-_0 (doto (-> string? assert)))] "Ident" [::&parser/ident (-> x .-value .-_0 (doto (-> string? assert)))] "Form" (let [[?fn & ?args] (-> x .-value .-_0 tokens->clojure)] [::&parser/fn-call ?fn ?args]) "Quote" [::&parser/quote (-> x .-value .-_0 ->clojure-token)])) (defn tokens->clojure [xs] ;; (prn 'tokens->clojure xs (.-tag xs)) (case (.-tag xs) "Nil" '() "Cons" (let [tuple2 (.-value xs)] (cons (->clojure-token (.-_0 tuple2)) (tokens->clojure (.-_1 tuple2)))) )) (defanalyser analyse-fn-call [::&parser/fn-call ?fn ?args] (exec [;; :let [_ (prn 'PRE '?fn ?fn)] macro? (is-macro? ?fn) scoped? (in-scope? ?fn) :let [;; _ (prn 'macro? ?fn macro?) ;; _ (prn 'scoped? scoped?) ] =fn (analyse-form* ?fn) ;; :let [_ (prn '=fn =fn)] ;; :let [_ (prn '=args =args)] ] (if (and macro? (not scoped?)) (do ;; (prn "MACRO CALL!" ?fn ?args =fn) (let [macro (match (:form =fn) [::global ?module ?name] (.newInstance (.loadClass loader (str ?module "$" (normalize-ident ?name))))) output (->clojure-token (.apply macro (->tokens ?args)))] ;; (prn "MACRO CALL!" macro output) (analyse-form* output))) (exec [=args (map-m analyse-form* ?args)] (return (annotated [::call =fn =args] [::&type/object "java.lang.Object" []])))) )) (defanalyser analyse-if [::&parser/if ?test ?then ?else] (exec [=test (analyse-form* ?test) ;; :let [_ (prn '=test =test)] ;; :let [_ (prn 'PRE '?then ?then)] =then (analyse-form* ?then) ;; :let [_ (prn '=then =then)] =else (analyse-form* ?else) ;; :let [_ (prn '=else =else)] ] (return (annotated [::if =test =then =else] ::&type/nothing)))) (defanalyser analyse-do [::&parser/do ?exprs] (exec [=exprs (map-m analyse-form* ?exprs)] (return (annotated [::do =exprs] (-> =exprs last :type))))) (let [fold-branches (fn [struct entry] (let [struct* (clojure.core.match/match (nth entry 0) [::pm-text ?text] (clojure.core.match/match (:type struct) ::text-tests (update-in struct [:patterns ?text] (fn [bodies] (if bodies (conj bodies (nth entry 1)) #{(nth entry 1)}))) nil (-> struct (assoc :type ::text-tests) (assoc-in [:patterns ?text] #{(nth entry 1)})) _ (assert false "Can't do match.")) [::pm-variant ?tag ?members] (clojure.core.match/match (:type struct) ::adt (update-in struct [:patterns] (fn [branches] (if-let [{:keys [arity cases]} (get branches ?tag)] (if (= arity (count ?members)) (-> branches (update-in [?tag :cases] conj {:case ?members :body (nth entry 1)}) (update-in [?tag :branches] conj (nth entry 1))) (assert false (str "Arity doesn't match. " (count ?members) "=/=" arity))) (assoc branches ?tag {:arity (count ?members) :cases [{:case ?members :body (nth entry 1)}] :branches #{(nth entry 1)}})))) nil (-> struct (assoc :type ::adt) (assoc-in [:patterns ?tag] {:arity (count ?members) :cases [{:case ?members :body (nth entry 1)}] :branches #{(nth entry 1)}})) _ (assert false "Can't do match.")) [::pm-local ?local] (update-in struct [:defaults] conj [::default ?local (nth entry 1)]))] (update-in struct* [:branches] conj (nth entry 1)))) base-struct {:type nil :patterns {} :defaults [] :branches #{}} generate-branches (fn generate-branches [data] (let [branches* (reduce fold-branches base-struct data)] ;; (prn 'generate-branches data) ;; (prn 'branches* branches*) ;; (.print System/out (prn-str 'branches* branches*)) ;; (.print System/out (prn-str '(:type branches*) (:type branches*))) (clojure.core.match/match (:type branches*) ::text-tests branches* ::adt (do (assert (<= (count (:defaults branches*)) 1)) {:type ::adt* :patterns (into {} (for [[?tag ?struct] (:patterns branches*) ;; :let [_ (prn '(:patterns branches*) ?tag ?struct)] ] [?tag {:parts (let [grouped-parts (apply map list (for [{:keys [case body]} (:cases ?struct)] (map #(vector % body) case)))] (map generate-branches grouped-parts)) :branches (:branches ?struct)}])) :default (-> branches* :defaults first) :branches (:branches branches*)}) nil {:type ::defaults, :stores (reduce (fn [total [_ ?store ?body]] (update-in total [?store] (fn [mapping] (if mapping (conj mapping ?body) #{?body})))) {} (:defaults branches*)) :branches (:branches branches*)}))) get-vars (fn get-vars [pattern] (clojure.core.match/match pattern [::&parser/ident ?name] (list ?name) [::&parser/variant ?tag ?members] (mapcat get-vars ?members) [::&parser/string ?text] '())) ->instructions (fn ->instructions [locals pattern] (clojure.core.match/match pattern [::&parser/variant ?tag ?members] [::pm-variant ?tag (map (partial ->instructions locals) ?members)] [::&parser/ident ?name] [::pm-local (get locals ?name)] [::&parser/string ?text] [::pm-text ?text] ))] (defn ->decision-tree [$scope $base branches] (let [;; Step 1: Get all vars vars+body (for [branch branches] (clojure.core.match/match branch [::&parser/case-branch ?pattern ?body] [(get-vars ?pattern) ?body])) max-registers (reduce max 0 (map (comp count first) vars+body)) ;; Step 2: Analyse bodies [_ branch-mappings branches*] (reduce (fn [[$link links branches*] branch] (clojure.core.match/match branch [::&parser/case-branch ?pattern ?body] [(inc $link) (assoc links $link ?body) (conj branches* [::&parser/case-branch ?pattern $link])])) [0 {} []] branches) ;; Step 4: Pattens -> Instructions branches** (for [[branch branch-vars] (map vector branches* (map first vars+body)) :let [[_ locals] (reduce (fn [[$local =locals] $var] [(inc $local) (assoc =locals $var [::local $scope $local])]) [$base {}] branch-vars)]] (clojure.core.match/match branch [::&parser/case-branch ?pattern ?body] [(->instructions locals ?pattern) ?body])) ;; _ (prn branches**) ;; Step 5: Re-structure branching ] [max-registers branch-mappings (generate-branches branches**)]))) (defanalyser analyse-case [::&parser/case ?variant ?branches] (exec [=variant (analyse-form* ?variant) ;; :let [_ (prn 'analyse-case '=variant =variant)] $scope scope-id ;; :let [_ (prn 'analyse-case '$scope $scope)] $base next-local-idx ;; :let [_ (prn 'analyse-case '$base $base)] [registers mappings tree] (exec [=branches (map-m (fn [?branch] (match ?branch [::&parser/case-branch [::&parser/ident ?name] ?body] (exec [=body (with-locals {?name (annotated [::local $scope $base] [::&type/object "java.lang.Object" []])} (analyse-form* ?body))] (return [::&parser/case-branch [::&parser/ident ?name] =body])) [::&parser/case-branch [::&parser/variant ?tag ?members] ?body] (exec [[_ locals+] (reduce-m (fn member-fold [[$local locals-map] ?member] (match ?member [::&parser/ident ?name] (return [(inc $local) (assoc locals-map ?name (annotated [::local $scope $local] [::&type/object "java.lang.Object" []]))]) [::&parser/variant ?subtag ?submembers] (reduce-m member-fold [$local locals-map] ?submembers) _ (return [$local locals-map]) )) [$base {}] ?members) ;; :let [_ (prn 'analyse-case 'locals+ locals+)] =body (with-locals locals+ (analyse-form* ?body)) ;; :let [_ (prn 'analyse-case '=body =body)] ] (return [::&parser/case-branch [::&parser/variant ?tag ?members] =body])))) ?branches)] (return (->decision-tree $scope $base =branches))) ;; :let [_ (prn 'analyse-case '[registers mappings tree] [registers mappings tree])] ] (return (annotated [::case (dec $base) =variant registers mappings tree] ::&type/nothing)))) (defanalyser analyse-let [::&parser/let ?label ?value ?body] (exec [=value (analyse-form* ?value) idx next-local-idx =body (with-local ?label =value (analyse-form* ?body))] (return (annotated [::let idx ?label =value =body] (:type =body))))) (defanalyser analyse-defclass [::&parser/defclass ?name ?fields] (let [=members {:fields (into {} (for [[class field] ?fields] [field {:access ::public :type class}]))} =class [::class ?name =members]] (exec [name module-name] (return (annotated [::defclass [name ?name] =members] ::&type/nothing))))) (defanalyser analyse-definterface [::&parser/definterface ?name ?members] (let [=members {:methods (into {} (for [[method [inputs output]] ?members] [method {:access ::public :type [inputs output]}]))} =interface [::interface ?name =members]] (exec [name module-name] (return (annotated [::definterface [name ?name] =members] ::&type/nothing))))) (defanalyser analyse-def [::&parser/def ?usage ?value] (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))) [::&parser/fn-call [::&parser/ident ?name] ?args] (let [args (for [a ?args] (match a [::&parser/ident ?ident] ?ident))] (exec [[=function =args =return] (within :types (&type/fresh-function (count args))) ;; :let [_ (prn '[=function =args =return] [=function =args =return])] ;; :let [env (-> {} ;; (assoc ?name =function) ;; (into (map vector args =args))) ;; _ (prn 'env env)] =value (with-scope ?name (with-scoped-name ?name =function (reduce (fn [inner [label type]] (with-local label type inner)) (analyse-form* ?value) (reverse (map vector args =args))))) ;; :let [_ (prn '=value =value)] =function (within :types (exec [_ (&type/solve =return (:type =value))] (&type/clean =function))) ;; :let [_ (prn '=function =function)] _ (define ?name {:mode ::function :access ::public :type =function})] (return (annotated [::def [?name args] =value] ::&type/nothing)))) )) (defanalyser analyse-defmacro [::&parser/defmacro [::&parser/fn-call [::&parser/ident ?name] ([[::&parser/ident ?tokens]] :seq)] ?value] (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 ?name {:mode ::macro :access ::public :type =function})] (return (annotated [::def [?name (list ?tokens)] =value] ::&type/nothing)))) (defanalyser analyse-lambda [::&parser/lambda ?args ?body] (exec [;; :let [_ (prn 'analyse-lambda ?args ?body)] [=function =args =return] (within :types (&type/fresh-function (count ?args))) ;; :let [_ (prn '[=function =args =return] [=function =args =return])] ;; :let [_ (prn 'PRE/?body ?body)] ;; _env (fn [state] [::&util/ok [state (:env state)]]) ;; :let [_ (prn 'analyse-lambda _env)] [=scope =frame =body] (with-fresh-env [?args =args] (analyse-form* ?body)) ;; :let [_ (prn '=body =body)] =function (within :types (exec [_ (&type/solve =return (:type =body))] (&type/clean =function))) ;; :let [_ (prn '=function =function)] ] (return (annotated [::lambda =scope =frame ?args =body] =function)))) (defanalyser analyse-import [::&parser/import ?class] (exec [_ (import-class ?class (last (string/split ?class #"\.")))] (return (annotated [::import ?class] ::&type/nothing)))) (defanalyser analyse-require [::&parser/require ?file ?alias] (let [;; _ (prn `[require ~?file ~?alias]) module-name (re-find #"[^/]+$" ?file) ;; _ (prn 'module-name module-name) ] (exec [_ (require-module module-name ?alias)] (return (annotated [::require ?file ?alias] ::&type/nothing))))) (defanalyser analyse-quote [::&parser/quote ?quoted] (return (annotated [::quote ?quoted] ::&type/nothing))) (def analyse-form (try-all-m [analyse-boolean analyse-int analyse-float analyse-char analyse-string analyse-variant analyse-tuple analyse-lambda analyse-ident analyse-access analyse-fn-call analyse-if analyse-do analyse-case analyse-let analyse-defclass analyse-definterface analyse-def analyse-defmacro analyse-import analyse-require analyse-quote])) ;; [Interface] (defn analyse [module-name tokens] (match ((repeat-m (with-scope module-name analyse-form)) {:name module-name, :forms tokens :deps {} :imports {} :defs {} :defs-env {} :lambda-scope [[] 0] :env (list (fresh-env 0)) :types &type/+init+}) [::&util/ok [?state ?forms]] (if (empty? (:forms ?state)) ?forms (assert false (str "Unconsumed input: " (pr-str (:forms ?state))))) [::&util/failure ?message] (assert false ?message)))