From 661c70e4d786e7b2188564beddc586f1a50e4656 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 3 Jan 2015 11:24:14 -0400 Subject: The language officially has a name: Lux (stylized as "lux"). --- src/lang/analyser.clj | 823 -------------------------------------------- src/lang/compiler.clj | 937 -------------------------------------------------- src/lang/lexer.clj | 172 --------- src/lang/parser.clj | 230 ------------- src/lang/type.clj | 148 -------- src/lang/util.clj | 168 --------- 6 files changed, 2478 deletions(-) delete mode 100644 src/lang/analyser.clj delete mode 100644 src/lang/compiler.clj delete mode 100644 src/lang/lexer.clj delete mode 100644 src/lang/parser.clj delete mode 100644 src/lang/type.clj delete mode 100644 src/lang/util.clj (limited to 'src/lang') diff --git a/src/lang/analyser.clj b/src/lang/analyser.clj deleted file mode 100644 index 30592c817..000000000 --- a/src/lang/analyser.clj +++ /dev/null @@ -1,823 +0,0 @@ -(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))) diff --git a/src/lang/compiler.clj b/src/lang/compiler.clj deleted file mode 100644 index 27652c1ad..000000000 --- a/src/lang/compiler.clj +++ /dev/null @@ -1,937 +0,0 @@ -(ns lang.compiler - (:refer-clojure :exclude [compile]) - (:require [clojure.string :as string] - [clojure.set :as set] - [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]] - [type :as &type] - [lexer :as &lexer] - [parser :as &parser] - [analyser :as &analyser]) - :reload) - (:import (org.objectweb.asm Opcodes - Label - ClassWriter - MethodVisitor))) - -(declare compile-form - compile) - -;; [Utils/General] -(defn ^:private write-file [file data] - ;; (println 'write-file file (alength data)) - (with-open [stream (java.io.BufferedOutputStream. (java.io.FileOutputStream. file))] - (.write stream data)) - ;; (Thread/sleep 2000) - ) - -(let [;; loader (proxy [ClassLoader] []) - ] - (defn load-class! [name file-name] - ;; (println "Defining..." name "@" file-name ;; (alength bytecode) - ;; ) - ;; (prn 'loader loader) - (.loadClass loader name) - ;; (println "SUCCESFUL LOAD!") - ;; (.defineClass loader name bytecode 0 (alength bytecode)) - )) - -(def ^:private +variant-class+ "test2.Variant") - -(defmacro ^:private defcompiler [name match body] - `(defn ~name [~'*state*] - (let [~'*class-name* (:class-name ~'*state*) - ~'*writer* (:writer ~'*state*) - ~'*parent* (:parent ~'*state*) - ~'*type* (:type (:form ~'*state*))] - ;; (prn '~name (:form (:form ~'*state*))) - (match (:form (:form ~'*state*)) - ~match - (do ~body - true) - _# - false)))) - -(defn ^:private unwrap-ident [ident] - (match ident - [::&parser/ident ?label] - ?label)) - -(defn ^:private unwrap-tagged [ident] - (match ident - [::&parser/tagged ?tag ?data] - [?tag ?data])) - -(defn ^:private ->class [class] - (string/replace class #"\." "/")) - -(def ^:private ->package ->class) - -(defn ^:private ->type-signature [class] - (case class - "Void" "V" - ;; else - (str "L" (->class class) ";"))) - -(defn ^:private ->java-sig [type] - (match type - ::&type/any - (->java-sig [::&type/object "java.lang.Object" []]) - - [::&type/object ?name []] - (->type-signature ?name) - - [::&type/variant ?tag ?value] - (->type-signature +variant-class+) - - [::&type/function ?args ?return] - (->java-sig [::&type/object "test2/Function" []]))) - -(defn ^:private method->sig [method] - (match method - [::&type/function ?args ?return] - (str "(" (apply str (map ->java-sig ?args)) ")" - (if (= ::&type/nothing ?return) - "V" - (->java-sig ?return))))) - -;; [Utils/Compilers] -(defcompiler ^:private compile-literal - [::&analyser/literal ?literal] - (cond (instance? java.lang.Integer ?literal) - (doto *writer* - (.visitTypeInsn Opcodes/NEW (->class "java.lang.Integer")) - (.visitInsn Opcodes/DUP) - (.visitLdcInsn ?literal) - (.visitMethodInsn Opcodes/INVOKESPECIAL (->class "java.lang.Integer") "" "(I)V")) - - (instance? java.lang.Float ?literal) - (doto *writer* - (.visitTypeInsn Opcodes/NEW (->class "java.lang.Float")) - (.visitInsn Opcodes/DUP) - (.visitLdcInsn ?literal) - (.visitMethodInsn Opcodes/INVOKESPECIAL (->class "java.lang.Float") "" "(F)V")) - - (instance? java.lang.Character ?literal) - (doto *writer* - (.visitTypeInsn Opcodes/NEW (->class "java.lang.Character")) - (.visitInsn Opcodes/DUP) - (.visitLdcInsn ?literal) - (.visitMethodInsn Opcodes/INVOKESPECIAL (->class "java.lang.Character") "" "(C)V")) - - (instance? java.lang.Boolean ?literal) - (if ?literal - ;; (.visitLdcInsn *writer* (int 1)) - (.visitFieldInsn *writer* Opcodes/GETSTATIC (->class "java.lang.Boolean") "TRUE" (->type-signature "java.lang.Boolean")) - ;; (.visitLdcInsn *writer* (int 0)) - (.visitFieldInsn *writer* Opcodes/GETSTATIC (->class "java.lang.Boolean") "FALSE" (->type-signature "java.lang.Boolean"))) - - (string? ?literal) - (.visitLdcInsn *writer* ?literal) - - :else - (assert false (str "[Unknown literal type] " ?literal " : " (class ?literal))))) - -(defcompiler ^:private compile-tuple - [::&analyser/tuple ?elems] - (let [num-elems (count ?elems)] - (let [tuple-class (str "test2/Tuple" num-elems)] - (doto *writer* - (.visitTypeInsn Opcodes/NEW tuple-class) - (.visitInsn Opcodes/DUP) - (.visitMethodInsn Opcodes/INVOKESPECIAL tuple-class "" "()V")) - (dotimes [idx num-elems] - (.visitInsn *writer* Opcodes/DUP) - (compile-form (assoc *state* :form (nth ?elems idx))) - (.visitFieldInsn *writer* Opcodes/PUTFIELD tuple-class (str "_" idx) "Ljava/lang/Object;"))))) - -(defcompiler ^:private compile-local - [::&analyser/local ?env ?idx] - (do ;; (prn 'LOCAL ?idx) - (doto *writer* - (.visitVarInsn Opcodes/ALOAD (int ?idx))))) - -(defcompiler ^:private compile-captured - [::&analyser/captured ?scope ?captured-id ?source] - (do ;; (prn 'CAPTURED [?scope ?captured-id]) - (doto *writer* - (.visitVarInsn Opcodes/ALOAD 0) - (.visitFieldInsn Opcodes/GETFIELD (apply str (interpose "$" ?scope)) (str "__" ?captured-id) "Ljava/lang/Object;")))) - -(defcompiler ^:private compile-global - [::&analyser/global ?owner-class ?name] - (do ;; (prn 'GLOBAL ?owner-class ?name *type*) - ;; (prn 'compile-global (->class (str ?owner-class "$" ?name)) "_datum") - (doto *writer* - (.visitFieldInsn Opcodes/GETSTATIC (->class (str ?owner-class "$" (normalize-ident ?name))) "_datum" "Ljava/lang/Object;" ;; (->java-sig *type*) - )))) - -;; (defcompiler ^:private compile-call -;; [::&analyser/call ?fn ?args] -;; (do (prn 'compile-call (:form ?fn) ?fn ?args) -;; (doseq [arg (reverse ?args)] -;; (compile-form (assoc *state* :form arg))) -;; (match (:form ?fn) -;; [::&analyser/global ?owner-class ?fn-name] -;; (let [signature (str "(" (apply str (repeat (count ?args) "Ljava/lang/Object;")) ")" "Ljava/lang/Object;")] -;; (doto *writer* -;; (.visitMethodInsn Opcodes/INVOKESTATIC (->class ?owner-class) ?fn-name signature)))))) - -(defcompiler ^:private compile-call - [::&analyser/call ?fn ?args] - (do ;; (prn 'compile-call (:form ?fn) ?fn ?args) - (match (:form ?fn) - [::&analyser/global ?owner-class ?fn-name] - (let [apply-signature "(Ljava/lang/Object;)Ljava/lang/Object;" - clo-field-sig (->type-signature "java.lang.Object") - counter-sig "I" - num-args (count ?args) - signature (if (> (count ?args) 1) - (str "(" (apply str counter-sig (repeat (dec num-args) clo-field-sig)) ")" "V") - (str "()" "V")) - call-class (str (->class ?owner-class) "$" (normalize-ident ?fn-name))] - (doto *writer* - (.visitTypeInsn Opcodes/NEW call-class) - (.visitInsn Opcodes/DUP) - (-> (doto (.visitLdcInsn (-> ?args count dec int)) - ;; (.visitInsn Opcodes/ICONST_0) - (-> (do (compile-form (assoc *state* :form arg))) - (->> (doseq [arg (butlast ?args)])))) - (->> (when (> (count ?args) 1)))) - (.visitMethodInsn Opcodes/INVOKESPECIAL call-class "" signature) - (do (compile-form (assoc *state* :form (last ?args)))) - (.visitMethodInsn Opcodes/INVOKEINTERFACE "test2/Function" "apply" apply-signature))) - - _ - (do (compile-form (assoc *state* :form ?fn)) - (let [apply-signature "(Ljava/lang/Object;)Ljava/lang/Object;"] - (doseq [arg ?args] - (compile-form (assoc *state* :form arg)) - (.visitMethodInsn *writer* Opcodes/INVOKEINTERFACE "test2/Function" "apply" apply-signature)))) - ))) - -(defcompiler ^:private compile-static-field - [::&analyser/static-field ?owner ?field] - (do ;; (prn 'compile-static-field ?owner ?field) - ;; (assert false) - (doto *writer* - (.visitFieldInsn Opcodes/GETSTATIC (->class ?owner) ?field (->java-sig *type*))) - )) - -(defcompiler ^:private compile-dynamic-field - [::&analyser/dynamic-field ?target ?owner ?field] - (do ;; (prn 'compile-static-field ?owner ?field) - ;; (assert false) - (compile-form (assoc *state* :form ?target)) - (doto *writer* - (.visitFieldInsn Opcodes/GETFIELD (->class ?owner) ?field (->java-sig *type*))) - )) - -(defcompiler ^:private compile-static-method - [::&analyser/static-method ?owner ?method-name ?method-type ?args] - (do ;; (prn 'compile-dynamic-access ?target ?owner ?method-name ?method-type ?args) - ;; (assert false) - (do (doseq [arg ?args] - (compile-form (assoc *state* :form arg))) - (doto *writer* - (.visitMethodInsn Opcodes/INVOKESTATIC (->class ?owner) ?method-name (method->sig ?method-type)) - (.visitInsn Opcodes/ACONST_NULL))) - )) - -(defcompiler ^:private compile-dynamic-method - [::&analyser/dynamic-method ?target ?owner ?method-name ?method-type ?args] - (do ;; (prn 'compile-dynamic-method ?target ?owner ?method-name ?method-type ?args) - ;; (assert false) - (do (compile-form (assoc *state* :form ?target)) - (doseq [arg ?args] - (compile-form (assoc *state* :form arg))) - (doto *writer* - (.visitMethodInsn Opcodes/INVOKEVIRTUAL (->class ?owner) ?method-name (method->sig ?method-type)) - (.visitInsn Opcodes/ACONST_NULL) - )) - )) - -(defcompiler ^:private compile-if - [::&analyser/if ?test ?then ?else] - (let [else-label (new Label) - end-label (new Label)] - ;; (println "PRE") - (compile-form (assoc *state* :form ?test)) - (doto *writer* - (.visitMethodInsn Opcodes/INVOKEVIRTUAL (->class "java.lang.Boolean") "booleanValue" "()Z") - (.visitJumpInsn Opcodes/IFEQ else-label)) - ;; (prn 'compile-if/?then (:form ?then)) - (compile-form (assoc *state* :form ?then)) - ;; (.visitInsn *writer* Opcodes/POP) - (doto *writer* - (.visitJumpInsn Opcodes/GOTO end-label) - (.visitLabel else-label)) - (compile-form (assoc *state* :form ?else)) - ;; (.visitInsn *writer* Opcodes/POP) - (.visitLabel *writer* end-label))) - -(defcompiler ^:private compile-do - [::&analyser/do ?exprs] - (do (doseq [expr (butlast ?exprs)] - (compile-form (assoc *state* :form expr)) - (.visitInsn *writer* Opcodes/POP)) - (compile-form (assoc *state* :form (last ?exprs))))) - -(let [+tag-sig+ (->type-signature "java.lang.String") - variant-class* (->class +variant-class+) - oclass (->class "java.lang.Object") - +tuple-field-sig+ (->type-signature "java.lang.Object") - equals-sig (str "(" (->type-signature "java.lang.Object") ")Z")] - (defn compile-decision-tree [writer mappings cleanup-level next-label default-label decision-tree] - ;; (prn 'compile-decision-tree cleanup-level decision-tree) - (match decision-tree - [::test-text ?text $body] - (let [$else (new Label)] - (doto writer - ;; object - (.visitInsn Opcodes/DUP) ;; object, object - (.visitLdcInsn ?text) ;; object, object, text - (.visitMethodInsn Opcodes/INVOKEVIRTUAL oclass "equals" equals-sig) ;; object, B - (.visitJumpInsn Opcodes/IFEQ $else) ;; object - (.visitInsn Opcodes/POP) ;; - (.visitJumpInsn Opcodes/GOTO next-label) - (.visitLabel $else) - (-> (doto (.visitInsn Opcodes/POP)) - (->> (dotimes [_ (inc cleanup-level)]))) - (.visitJumpInsn Opcodes/GOTO default-label))) - - [::store [::&analyser/local _ ?idx] $body] - (doto writer - (.visitVarInsn Opcodes/ASTORE ?idx) - (-> (.visitJumpInsn Opcodes/GOTO (get mappings $body)) - (->> (when (nil? next-label))))) - - [::test-adt ?branches ?cases] - (doto writer - ;; object - (.visitTypeInsn Opcodes/CHECKCAST variant-class*) ;; variant - (.visitInsn Opcodes/DUP) ;; variant, variant - (.visitFieldInsn Opcodes/GETFIELD variant-class* "tag" +tag-sig+) ;; variant, tag - (-> (doto (.visitInsn Opcodes/DUP) ;; variant, tag, tag - (.visitLdcInsn ?tag) ;; variant, tag, tag, text - (.visitMethodInsn Opcodes/INVOKEVIRTUAL oclass "equals" equals-sig) ;; variant, tag, B - (.visitJumpInsn Opcodes/IFEQ tag-else-label) ;; variant, tag - (.visitInsn Opcodes/POP) ;; variant - (do (let [arity (-> ?subcases first (nth 2) count) - tuple-class (str "test2/Tuple" arity) - ;; _ (prn ?tag arity tuple-class) - ] - (when (> arity 0) - (doto writer - (.visitInsn Opcodes/DUP) ;; variant, variant - (.visitFieldInsn Opcodes/GETFIELD variant-class* "value" +tuple-field-sig+) ;; variant, object - (.visitTypeInsn Opcodes/CHECKCAST tuple-class) ;; variant, tuple - )) - (doseq [subcase ?subcases - :let [else-label (new Label)]] - (match subcase - [::subcase $body ?subseq] - (do (when (not (empty? ?subseq)) - (doseq [[?subpart ?subidx] (map vector ?subseq (range (count ?subseq))) - :let [next-label (new Label)]] - (doto writer - (.visitInsn Opcodes/DUP) ;; variant, tuple, tuple - (.visitFieldInsn Opcodes/GETFIELD tuple-class (str "_" ?subidx) +tuple-field-sig+) ;; variant, tuple, object - (compile-decision-tree mappings cleanup-level next-label else-label ?subpart) ;; variant, tuple - (.visitLabel next-label)))) - (doto writer - (-> (doto (.visitInsn Opcodes/POP)) - (->> (dotimes [_ (+ cleanup-level (if (> arity 0) 2 1))]))) ;; - (.visitJumpInsn Opcodes/GOTO (or next-label (get mappings $body))) - (.visitLabel else-label))) - )) - )) - ;; variant, tag -> - (.visitLabel tag-else-label)) - (->> (doseq [[?tag ?subcases] ?cases - ;; :let [_ (.print System/out (prn-str 'COMPILE-PATTERN ?tag ?subcases))] - :let [tag-else-label (new Label)]]))) - (-> (doto (.visitInsn Opcodes/POP)) - (->> (dotimes [_ (+ cleanup-level 2)]))) - (.visitJumpInsn Opcodes/GOTO default-label))) - )) - -(defn sequence-parts [branches parts] - ;; (.print System/out (prn-str 'sequence-parts branches parts)) - (if (empty? parts) - '(()) - (let [[head & tail] parts - expanded (case (:type head) - ::&analyser/defaults - (for [[?local ?supports] (:stores head) - ?body (set/intersection branches ?supports) - ;; :when (set/subset? branches ?supports) - ] - [[::store ?local ?body] #{?body}]) - - ::&analyser/text-tests - (concat (for [[?text ?supports] (:patterns head) - ?body (set/intersection branches ?supports) - ;; :when (set/subset? branches ?supports) - ] - [[::test-text ?text ?body] #{?body}]) - (for [[_ ?local ?body] (:defaults head) - :when (contains? branches ?body)] - [[::store ?local ?body] #{?body}])) - - ::&analyser/adt* - (do ;; (prn '(:default head) (:default head)) - ;; (assert (nil? (:default head))) - (concat (let [patterns (into {} (for [[?tag ?struct] (:patterns head) - ;; :let [_ (.print System/out (prn-str 'PATTERN ?tag ?struct))] - :let [?parts (:parts ?struct) - num-parts (count ?parts) - ?supports (:branches ?struct) - subcases (for [?body (set/intersection branches ?supports) - subseq (sequence-parts #{?body} ?parts) - ;; :let [_ (when (= "Symbol" ?tag) - ;; (.print System/out (prn-str 'counting ?tag num-parts (count subseq) subseq)))] - :when (= num-parts (count subseq))] - [::subcase ?body subseq])] - :when (not (empty? subcases))] - [?tag subcases]))] - (if (empty? patterns) - '() - (list [[::test-adt branches patterns] - branches]))) - (if-let [[_ ?local ?body] (:default head)] - (for [?body (set/intersection branches #{?body})] - [[::store ?local ?body] #{?body}]) - '()))) - )] - (for [[step branches*] expanded - tail* (sequence-parts branches* tail) - ;; :let [_ (.print System/out (prn-str 'tail* tail*))] - ] - (cons step tail*))))) - -(def !case-vars (atom -1)) - -(let [oclass (->class "java.lang.Object") - equals-sig (str "(" (->type-signature "java.lang.Object") ")Z") - ex-class (->class "java.lang.IllegalStateException")] - (defcompiler ^:private compile-case - ;; [::&analyser/case ?variant ?branches] - [::&analyser/case ?base-idx ?variant ?max-registers ?branch-mappings ?decision-tree] - (do ;; (prn 'compile-case ?base-idx ?variant ?max-registers ?branch-mappings ?decision-tree) - ;; (assert false) - (let [start-label (new Label) - end-label (new Label) - ;; default-label (new Label) - entries (for [[?branch ?body] ?branch-mappings - :let [label (new Label)]] - [[?branch label] - [label ?body]]) - mappings* (into {} (map first entries))] - (dotimes [idx ?max-registers] - (.visitLocalVariable *writer* (str "__" (swap! !case-vars inc) "__") (->java-sig ::&type/any) nil start-label end-label (+ ?base-idx (inc idx)))) - (compile-form (assoc *state* :form ?variant)) - (.visitLabel *writer* start-label) - (let [default-label (new Label) - default-code (:default ?decision-tree)] - ;; (prn 'sequence-parts - ;; (sequence-parts (:branches ?decision-tree) (list ?decision-tree))) - (doseq [decision-tree (map first (sequence-parts (:branches ?decision-tree) (list ?decision-tree)))] - (compile-decision-tree *writer* mappings* 0 nil default-label decision-tree)) - (.visitLabel *writer* default-label) - (when (not default-code) - ;; (do (prn 'default-code default-code) - ;; (assert false) - ;; ;; (.visitInsn Opcodes/POP) ;; ... - ;; (compile-form (assoc *state* :form default-code)) - ;; (.visitJumpInsn *writer* Opcodes/GOTO end-label)) - (doto *writer* - ;; (.visitInsn Opcodes/POP) - (.visitTypeInsn Opcodes/NEW ex-class) - (.visitInsn Opcodes/DUP) - (.visitMethodInsn Opcodes/INVOKESPECIAL ex-class "" "()V") - (.visitInsn Opcodes/ATHROW)))) - ;; (compile-decision-tree *state* *writer* mappings* 1 nil (:branches ?decision-tree) ?decision-tree) - (doseq [[?label ?body] (map second entries)] - (.visitLabel *writer* ?label) - (compile-form (assoc *state* :form ?body)) - (.visitJumpInsn *writer* Opcodes/GOTO end-label)) - (.visitLabel *writer* end-label) - )) - )) - -(defcompiler ^:private compile-let - [::&analyser/let ?idx ?label ?value ?body] - (let [start-label (new Label) - end-label (new Label) - ?idx (int ?idx)] - ;; (prn '(:type ?value) (:type ?value) (->java-sig (:type ?value))) - (.visitLocalVariable *writer* (normalize-ident ?label) (->java-sig (:type ?value)) nil start-label end-label ?idx) - (assert (compile-form (assoc *state* :form ?value)) "CAN't COMPILE LET-VALUE") - (doto *writer* - (.visitVarInsn Opcodes/ASTORE ?idx) - (.visitLabel start-label)) - (assert (compile-form (assoc *state* :form ?body)) "CAN't COMPILE LET-BODY") - (.visitLabel *writer* end-label))) - -(defn ^:private compile-method-function [writer class-name fn-name num-args body *state*] - (let [outer-class (->class class-name) - clo-field-sig (->type-signature "java.lang.Object") - counter-sig "I" - apply-signature "(Ljava/lang/Object;)Ljava/lang/Object;" - real-signature (str "(" (apply str (repeat num-args clo-field-sig)) ")" "Ljava/lang/Object;") - current-class (str outer-class "$" (normalize-ident fn-name)) - num-captured (dec num-args) - init-signature (if (not= 0 num-captured) - (str "(" (apply str counter-sig (repeat num-captured clo-field-sig)) ")" "V") - (str "()" "V"))] - (.visitInnerClass writer current-class outer-class nil (+ Opcodes/ACC_STATIC Opcodes/ACC_SYNTHETIC)) - (let [=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) - (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_SUPER) - current-class nil "java/lang/Object" (into-array ["test2/Function"])) - (-> (doto (.visitField (+ Opcodes/ACC_PRIVATE Opcodes/ACC_FINAL) "_counter" counter-sig nil nil) - (.visitEnd)) - (->> (when (not= 0 num-captured))))) - =impl (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "impl" real-signature nil nil) - (.visitCode) - (->> (assoc *state* :form body :writer) compile-form) - (.visitInsn Opcodes/ARETURN) - (.visitMaxs 0 0) - (.visitEnd)) - =init (doto (.visitMethod =class Opcodes/ACC_PUBLIC "" init-signature nil nil) - (.visitCode) - (.visitVarInsn Opcodes/ALOAD 0) - (.visitMethodInsn Opcodes/INVOKESPECIAL "java/lang/Object" "" "()V") - (-> (doto (.visitVarInsn Opcodes/ALOAD 0) - (.visitVarInsn Opcodes/ILOAD 1) - (.visitFieldInsn Opcodes/PUTFIELD current-class "_counter" counter-sig) - (-> (doto (.visitVarInsn Opcodes/ALOAD 0) - (.visitVarInsn Opcodes/ALOAD (+ clo_idx 2)) - (.visitFieldInsn Opcodes/PUTFIELD current-class field-name clo-field-sig)) - (->> (let [field-name (str "_" clo_idx)] - (doto (.visitField =class (+ Opcodes/ACC_PRIVATE Opcodes/ACC_FINAL) field-name clo-field-sig nil nil) - (.visitEnd))) - (dotimes [clo_idx num-captured])))) - (->> (when (not= 0 num-captured)))) - (.visitInsn Opcodes/RETURN) - (.visitMaxs 0 0) - (.visitEnd)) - =method (let [default-label (new Label) - branch-labels (for [_ (range num-captured)] - (new Label))] - (doto (.visitMethod =class Opcodes/ACC_PUBLIC "apply" apply-signature nil nil) - (.visitCode) - (-> (doto (.visitVarInsn Opcodes/ALOAD 0) - (.visitFieldInsn Opcodes/GETFIELD current-class "_counter" counter-sig) - (.visitTableSwitchInsn 0 (dec num-captured) default-label (into-array Label branch-labels)) - (-> (doto (.visitLabel branch-label) - (.visitTypeInsn Opcodes/NEW current-class) - (.visitInsn Opcodes/DUP) - (.visitVarInsn Opcodes/ALOAD 0) - (.visitFieldInsn Opcodes/GETFIELD current-class "_counter" counter-sig) - (.visitInsn Opcodes/ICONST_1) - (.visitInsn Opcodes/IADD) - (-> (doto (.visitVarInsn Opcodes/ALOAD 0) - (.visitFieldInsn Opcodes/GETFIELD current-class (str "_" clo_idx) clo-field-sig)) - (->> (dotimes [clo_idx current-captured]))) - (.visitVarInsn Opcodes/ALOAD 1) - (-> (.visitInsn Opcodes/ACONST_NULL) - (->> (dotimes [clo_idx (- (dec num-captured) current-captured)]))) - (.visitMethodInsn Opcodes/INVOKESPECIAL current-class "" init-signature) - ;; (.visitJumpInsn Opcodes/GOTO end-label) - (.visitInsn Opcodes/ARETURN)) - (->> (doseq [[branch-label current-captured] (map vector branch-labels (range (count branch-labels))) - ;; :let [_ (prn '[branch-label current-captured] [branch-label current-captured])] - ]))) - (.visitLabel default-label) - (-> (doto (.visitVarInsn Opcodes/ALOAD 0) - (.visitFieldInsn Opcodes/GETFIELD current-class (str "_" clo_idx) clo-field-sig)) - (->> (dotimes [clo_idx num-captured])))) - (->> (when (not= 0 num-captured)))) - (.visitVarInsn Opcodes/ALOAD 1) - (.visitMethodInsn Opcodes/INVOKESTATIC current-class "impl" real-signature) - ;; (.visitLabel end-label) - (.visitInsn Opcodes/ARETURN) - (.visitMaxs 0 0) - (.visitEnd))) - _ (.visitEnd =class) - bytecode (.toByteArray =class)] - (write-file (str current-class ".class") bytecode) - (load-class! (string/replace current-class #"/" ".") (str current-class ".class"))) - )) - -(defn compile-field [writer class-name ?name body state] - (let [outer-class (->class class-name) - datum-sig (->type-signature "java.lang.Object") - current-class (str outer-class "$" ?name)] - (.visitInnerClass writer current-class outer-class nil (+ Opcodes/ACC_STATIC Opcodes/ACC_SYNTHETIC)) - (let [=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) - (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_SUPER) - current-class nil "java/lang/Object" (into-array ["test2/Function"])) - (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_datum" datum-sig nil nil) - (doto (.visitEnd))) - (-> (.visitMethod Opcodes/ACC_PUBLIC "" "()V" nil nil) - (doto (.visitCode) - (->> (assoc state :form body :writer) compile-form) - (.visitFieldInsn Opcodes/PUTSTATIC current-class "_datum" datum-sig) - (.visitInsn Opcodes/RETURN) - (.visitMaxs 0 0) - (.visitEnd))) - (.visitEnd)) - bytecode (.toByteArray =class)] - (write-file (str current-class ".class") bytecode) - (load-class! (string/replace current-class #"/" ".") (str current-class ".class"))) - )) - -(defcompiler ^:private compile-def - [::&analyser/def ?form ?body] - (do ;; (prn 'compile-def ?form) - (match ?form - (?name :guard string?) - (compile-field *writer* *class-name* ?name ?body *state*) - - [?name ?args] - (do ;; (prn 'compile-def `(~'def (~(symbol ?name) ~@(map symbol ?args)))) - (if (= "main" ?name) - (let [signature "([Ljava/lang/String;)V" - =method (doto (.visitMethod *writer* (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) ?name signature nil nil) - (.visitCode))] - ;; (prn 'FN/?body ?body) - (compile-form (assoc *state* :parent *writer* :writer =method :form ?body)) - (doto =method - (.visitInsn Opcodes/RETURN) - (.visitMaxs 0 0) - (.visitEnd))) - (compile-method-function *writer* *class-name* ?name (count ?args) ?body *state*))) - ))) - -(defn ^:private captured? [form] - (match form - [::&analyser/captured ?closure-id ?captured-id ?source] - true - _ - false)) - -(defcompiler ^:private compile-lambda - [::&analyser/lambda ?scope ?frame ?args ?body] - (let [;; _ (prn '[?scope ?frame] ?scope ?frame) - num-args (count ?args) - outer-class (->class *class-name*) - clo-field-sig (->type-signature "java.lang.Object") - counter-sig "I" - apply-signature "(Ljava/lang/Object;)Ljava/lang/Object;" - real-signature (str "(" (apply str (repeat num-args clo-field-sig)) ")" "Ljava/lang/Object;") - current-class (apply str (interpose "$" ?scope)) - num-captured (dec num-args) - init-signature (str "(" (apply str (repeat (->> (:mappings ?frame) - (map (comp :form second)) - (filter captured?) - count) - clo-field-sig)) - (if (not= 0 num-captured) - (apply str counter-sig (repeat num-captured clo-field-sig))) - ")" - "V") - ;; _ (prn current-class 'init-signature init-signature) - ;; _ (prn current-class 'real-signature real-signature) - =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) - (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_SUPER) - current-class nil "java/lang/Object" (into-array ["test2/Function"])) - (-> (doto (.visitField (+ Opcodes/ACC_PRIVATE Opcodes/ACC_FINAL) captured-name clo-field-sig nil nil) - (.visitEnd)) - (->> (let [captured-name (str "__" ?captured-id)]) - (match (:form ?captured) - [::&analyser/captured ?closure-id ?captured-id ?source]) - (doseq [[?name ?captured] (:mappings ?frame) - :when (captured? (:form ?captured))]))) - (-> (doto (.visitField (+ Opcodes/ACC_PRIVATE Opcodes/ACC_FINAL) "_counter" counter-sig nil nil) - (.visitEnd)) - (->> (when (not= 0 num-captured))))) - =init (doto (.visitMethod =class Opcodes/ACC_PUBLIC "" init-signature nil nil) - (.visitCode) - (.visitVarInsn Opcodes/ALOAD 0) - (.visitMethodInsn Opcodes/INVOKESPECIAL "java/lang/Object" "" "()V") - (-> (doto (.visitVarInsn Opcodes/ALOAD 0) - (.visitVarInsn Opcodes/ALOAD (inc ?captured-id)) - (.visitFieldInsn Opcodes/PUTFIELD current-class captured-name clo-field-sig)) - (->> (let [captured-name (str "__" ?captured-id)]) - (match (:form ?captured) - [::&analyser/captured ?closure-id ?captured-id ?source]) - (doseq [[?name ?captured] (:mappings ?frame) - :when (captured? (:form ?captured))]))) - (-> (doto (.visitVarInsn Opcodes/ALOAD 0) - (.visitVarInsn Opcodes/ILOAD (inc (count (:mappings ?frame)))) - (.visitFieldInsn Opcodes/PUTFIELD current-class "_counter" counter-sig) - (-> (doto (.visitVarInsn Opcodes/ALOAD 0) - (.visitVarInsn Opcodes/ALOAD (+ clo_idx offset)) - (.visitFieldInsn Opcodes/PUTFIELD current-class field-name clo-field-sig)) - (->> (let [field-name (str "_" clo_idx)] - (doto (.visitField =class (+ Opcodes/ACC_PRIVATE Opcodes/ACC_FINAL) field-name clo-field-sig nil nil) - (.visitEnd))) - (dotimes [clo_idx num-captured]) - (let [offset (+ 2 (count (:mappings ?frame)))])))) - (->> (when (not= 0 num-captured)))) - (.visitInsn Opcodes/RETURN) - (.visitMaxs 0 0) - (.visitEnd)) - =method (let [default-label (new Label) - branch-labels (for [_ (range num-captured)] - (new Label))] - (doto (.visitMethod =class Opcodes/ACC_PUBLIC "apply" apply-signature nil nil) - (.visitCode) - (.visitVarInsn Opcodes/ALOAD 0) - (-> (doto (.visitVarInsn Opcodes/ALOAD 0) - (.visitFieldInsn Opcodes/GETFIELD current-class "_counter" counter-sig) - (.visitTableSwitchInsn 0 (dec num-captured) default-label (into-array Label branch-labels)) - (-> (doto (.visitLabel branch-label) - (.visitTypeInsn Opcodes/NEW current-class) - (.visitInsn Opcodes/DUP) - (-> (doto (.visitVarInsn Opcodes/ALOAD 0) - (.visitFieldInsn Opcodes/GETFIELD current-class (str "__" capt_idx) clo-field-sig)) - (->> (dotimes [capt_idx (count (:mappings ?frame))]))) - (.visitVarInsn Opcodes/ALOAD 0) - (.visitFieldInsn Opcodes/GETFIELD current-class "_counter" counter-sig) - (.visitInsn Opcodes/ICONST_1) - (.visitInsn Opcodes/IADD) - (-> (doto (.visitVarInsn Opcodes/ALOAD 0) - (.visitFieldInsn Opcodes/GETFIELD current-class (str "_" clo_idx) clo-field-sig)) - (->> (dotimes [clo_idx current-captured]))) - (.visitVarInsn Opcodes/ALOAD 1) - (-> (.visitInsn Opcodes/ACONST_NULL) - (->> (dotimes [clo_idx (- (dec num-captured) current-captured)]))) - (.visitMethodInsn Opcodes/INVOKESPECIAL current-class "" init-signature) - (.visitInsn Opcodes/ARETURN)) - (->> (doseq [[branch-label current-captured] (map vector branch-labels (range (count branch-labels))) - ;; :let [_ (prn '[branch-label current-captured] [branch-label current-captured])] - ]))) - (.visitLabel default-label) - (-> (doto (.visitVarInsn Opcodes/ALOAD 0) - (.visitFieldInsn Opcodes/GETFIELD current-class (str "_" clo_idx) clo-field-sig)) - (->> (dotimes [clo_idx num-captured])))) - (->> (when (not= 0 num-captured)))) - (.visitVarInsn Opcodes/ALOAD 1) - (.visitMethodInsn Opcodes/INVOKEVIRTUAL current-class "impl" real-signature) - (.visitInsn Opcodes/ARETURN) - (.visitMaxs 0 0) - (.visitEnd))) - ;; _ (prn 'LAMBDA/?body ?body) - =impl (doto (.visitMethod =class Opcodes/ACC_PUBLIC "impl" real-signature nil nil) - (.visitCode) - (->> (assoc *state* :form ?body :writer) - compile-form) - (.visitInsn Opcodes/ARETURN) - (.visitMaxs 0 0) - (.visitEnd)) - _ (.visitEnd =class) - bytecode (.toByteArray =class)] - (write-file (str current-class ".class") bytecode) - (load-class! (string/replace current-class #"/" ".") (str current-class ".class")) - ;; (apply prn 'LAMBDA ?scope ?args (->> (:mappings ?frame) - ;; (map second) - ;; (map :form) - ;; (filter captured?))) - (doto *writer* - (.visitTypeInsn Opcodes/NEW current-class) - (.visitInsn Opcodes/DUP) - (-> (do (compile-form (assoc *state* :form ?source))) - (->> (match (:form ?captured) - [::&analyser/captured ?closure-id ?captured-id ?source]) - (doseq [[?name ?captured] (:mappings ?frame) - :when (captured? (:form ?captured))]))) - (-> (doto (.visitInsn Opcodes/ICONST_0) - ;; (.visitInsn Opcodes/ICONST_0) - (-> (.visitInsn Opcodes/ACONST_NULL) - (->> (doseq [_ (butlast ?args)])))) - (->> (when (> (count ?args) 1)))) - (.visitMethodInsn Opcodes/INVOKESPECIAL current-class "" init-signature)) - )) - -(defcompiler ^:private compile-defclass - [::&analyser/defclass [?package ?name] ?members] - (let [parent-dir (->package ?package) - =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) - (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER) - (str parent-dir "/" ?name) nil "java/lang/Object" nil))] - (doseq [[field props] (:fields ?members)] - (doto (.visitField =class Opcodes/ACC_PUBLIC field (->type-signature (:type props)) nil nil) - (.visitEnd))) - (doto (.visitMethod =class Opcodes/ACC_PUBLIC "" "()V" nil nil) - (.visitCode) - (.visitVarInsn Opcodes/ALOAD 0) - (.visitMethodInsn Opcodes/INVOKESPECIAL "java/lang/Object" "" "()V") - (.visitInsn Opcodes/RETURN) - (.visitMaxs 0 0) - (.visitEnd)) - (.visitEnd =class) - (.mkdirs (java.io.File. parent-dir)) - (write-file (str parent-dir "/" ?name ".class") (.toByteArray =class)) - (load-class! (string/replace (str parent-dir "/" ?name) #"/" ".") (str parent-dir "/" ?name ".class")))) - -(defcompiler ^:private compile-definterface - [::&analyser/definterface [?package ?name] ?members] - (let [parent-dir (->package ?package) - =interface (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) - (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_INTERFACE ;; Opcodes/ACC_ABSTRACT - ) - (str parent-dir "/" ?name) nil "java/lang/Object" nil))] - (doseq [[?method ?props] (:methods ?members) - :let [[?args ?return] (:type ?props) - signature (str "(" (reduce str "" (map ->type-signature ?args)) ")" (->type-signature ?return))]] - (.visitMethod =interface (+ Opcodes/ACC_PUBLIC Opcodes/ACC_ABSTRACT) ?method signature nil nil)) - (.visitEnd =interface) - (.mkdirs (java.io.File. parent-dir)) - (write-file (str parent-dir "/" ?name ".class") (.toByteArray =interface)) - (load-class! (string/replace (str parent-dir "/" ?name) #"/" ".") (str parent-dir "/" ?name ".class")))) - -(defcompiler ^:private compile-variant - [::&analyser/variant ?tag ?members] - (let [variant-class* (->class +variant-class+)] - ;; (prn 'compile-variant ?tag ?value) - (doto *writer* - (.visitTypeInsn Opcodes/NEW variant-class*) - (.visitInsn Opcodes/DUP) - (.visitMethodInsn Opcodes/INVOKESPECIAL variant-class* "" "()V") - (.visitInsn Opcodes/DUP) - (.visitLdcInsn ?tag) - (.visitFieldInsn Opcodes/PUTFIELD variant-class* "tag" (->type-signature "java.lang.String")) - (.visitInsn Opcodes/DUP)) - (let [tuple-class (str "test2/Tuple" (count ?members))] - (doto *writer* - (.visitTypeInsn Opcodes/NEW tuple-class) - (.visitInsn Opcodes/DUP) - (.visitMethodInsn Opcodes/INVOKESPECIAL tuple-class "" "()V")) - (doseq [[?tfield ?member] (mapv vector (range (count ?members)) ?members)] - (doto *writer* - (.visitInsn Opcodes/DUP) - (do (compile-form (assoc *state* :form ?member))) - (.visitFieldInsn Opcodes/PUTFIELD tuple-class (str "_" ?tfield) "Ljava/lang/Object;")))) - (doto *writer* - (.visitFieldInsn Opcodes/PUTFIELD variant-class* "value" "Ljava/lang/Object;")) - )) - -(defcompiler compile-import - [::&analyser/import ?class] - nil) - -(defcompiler compile-require - [::&analyser/require ?file ?alias] - (let [module-name (re-find #"[^/]+$" ?file) - ;; _ (prn 'module-name module-name) - source-code (slurp (str module-name ".lang")) - ;; _ (prn 'source-code source-code) - tokens (&lexer/lex source-code) - ;; _ (prn 'tokens tokens) - syntax (&parser/parse tokens) - ;; _ (prn 'syntax syntax) - ;; ann-syntax (&analyser/analyse module-name syntax) - ;; _ (prn 'ann-syntax ann-syntax) - bytecode (compile module-name syntax)] - ;; (write-file (str module-name ".class") bytecode) - ;; (load-class! (string/replace module-name #"/" ".") (str module-name ".class")) - nil)) - -(defn quoted->token [quoted] - ;; (prn 'quoted->token quoted) - (match quoted - [::&parser/string ?text] - {:form [::&analyser/variant "Text" (list {:form [::&analyser/literal ?text] - :type [::&type/object "java.lang.String" []]})] - :type [::&type/variant "Text" (list [::&type/object "java.lang.String" []])]} - - [::&parser/fn-call ?fn ?args] - (let [members* (quoted->token (cons ?fn ?args))] - {:form [::&analyser/variant "Form" (list members*)] - :type [::&type/variant "Form" (list (:type members*))]}) - - ([] :seq) - {:form [::&analyser/variant "Nil" '()] - :type [::&type/variant "Nil" '()]} - - ([head & tail] :seq) - (let [head* (quoted->token head) - tail* (quoted->token tail)] - {:form [::&analyser/variant "Cons" (list head* tail*)] - :type [::&type/variant "Nil" (list (:type head*) (:type tail*))]}))) - -(defcompiler compile-quote - [::&analyser/quote ?quoted] - (compile-form (assoc *state* :form (quoted->token ?quoted)))) - -(let [+compilers+ [compile-literal - compile-variant - compile-tuple - compile-local - compile-captured - compile-global - compile-call - compile-static-field - compile-dynamic-field - compile-static-method - compile-dynamic-method - compile-if - compile-do - compile-case - compile-let - compile-lambda - compile-def - compile-defclass - compile-definterface - compile-import - compile-require - compile-quote]] - (defn ^:private compile-form [state] - ;; (prn 'compile-form/state state) - (or (some #(% state) +compilers+) - (assert false (str "Can't compile: " (pr-str (:form state))))))) - -;; [Interface] -(defn compile [class-name inputs] - ;; (prn 'inputs inputs) - (let [=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) - (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER) - (->class class-name) nil "java/lang/Object" nil)) - compiler-state {:class-name class-name - :writer =class - :form nil - :parent nil}] - (match ((repeat-m - (&analyser/with-scope class-name - (exec [ann-input &analyser/analyse-form - :let [_ (when (not (compile-form (assoc compiler-state :form ann-input))) - (assert false ann-input))]] - (return ann-input)))) - {:name class-name - :forms inputs - :deps {} - :imports {} - :defs {} - :defs-env {} - :lambda-scope [[] 0] - :env (list (&analyser/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)) - ;;; - (.visitEnd =class) - (let [bytecode (.toByteArray =class)] - (write-file (str class-name ".class") bytecode) - (load-class! (string/replace class-name #"/" ".") (str class-name ".class")) - bytecode) - ) - ;; (comment - ;; (-> (java.io.File. "./") .toURL vector into-array java.net.URLClassLoader. (.loadClass "test2")) - ;; (-> (java.io.File. "./") .toURL vector into-array java.net.URLClassLoader. (.loadClass "test2.Function")) - ;; (let [test2 (-> (java.io.File. "./") .toURL vector into-array java.net.URLClassLoader. (.loadClass "test2")) - ;; main (first (.getDeclaredMethods test2))] - ;; (.invoke main nil (to-array [nil]))) - ;; ) - ) diff --git a/src/lang/lexer.clj b/src/lang/lexer.clj deleted file mode 100644 index 7b23c5947..000000000 --- a/src/lang/lexer.clj +++ /dev/null @@ -1,172 +0,0 @@ -(ns lang.lexer - (:require [clojure.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]])) - -(declare lex-forms lex-list lex-tuple lex-record lex-tag) - -;; [Utils] -(defn ^:private lex-regex [regex] - (fn [text] - (if-let [[match] (re-find regex text)] - (return* (.substring text (.length match)) match) - (fail* (str "Pattern failed: " regex " -- " text))))) - -(defn ^:private lex-regex2 [regex] - (fn [text] - (if-let [[match tok1 tok2] (re-find regex text)] - (return* (.substring text (.length match)) [tok1 tok2]) - (fail* (str "Pattern failed: " regex " -- " text))))) - -(defn ^:private lex-str [prefix] - (fn [text] - (if (.startsWith text prefix) - (return* (.substring text (.length prefix)) prefix) - (fail* (str "String failed: " prefix " -- " text))))) - -(defn ^:private escape-char [escaped] - (condp = escaped - "\\t" (return "\t") - "\\b" (return "\b") - "\\n" (return "\n") - "\\r" (return "\r") - "\\f" (return "\f") - "\\\"" (return "\"") - "\\\\" (return "\\") - ;; else - (fail (str "Unknown escape character: " escaped)))) - -(def ^:private lex-string-body - (try-all-m [(exec [[prefix escaped] (lex-regex2 #"(?s)^([^\"\\]*)(\\.)") - ;; :let [_ (prn '[prefix escaped] [prefix escaped])] - unescaped (escape-char escaped) - ;; :let [_ (prn 'unescaped unescaped)] - postfix lex-string-body - ;; :let [_ (prn 'postfix postfix)] - ;; :let [_ (prn 'FULL (str prefix unescaped postfix))] - ] - (return (str prefix unescaped postfix))) - (lex-regex #"(?s)^([^\"\\]*)")])) - -;; [Lexers] -(def ^:private lex-white-space (lex-regex #"^(\s+)")) - -(def +ident-re+ #"^([a-zA-Z\-\+\_\=!@$%^&*<>\.,/\\\|':\~\?][0-9a-zA-Z\-\+\_\=!@$%^&*<>\.,/\\\|':\~\?]*)") - -(do-template [ ] - (def - (exec [token (lex-regex )] - (return [ token]))) - - ^:private lex-boolean ::boolean #"^(true|false)" - ^:private lex-float ::float #"^(0|[1-9][0-9]*)\.[0-9]+" - ^:private lex-int ::int #"^(0|[1-9][0-9]*)" - ^:private lex-ident ::ident +ident-re+) - -(def ^:private lex-char - (exec [_ (lex-str "#\"") - token (try-all-m [(exec [escaped (lex-regex #"^(\\.)")] - (escape-char escaped)) - (lex-regex #"^(.)")]) - _ (lex-str "\"")] - (return [::char token]))) - -(def ^:private lex-string - (exec [_ (lex-str "\"") - ;; state &util/get-state - ;; :let [_ (prn 'PRE state)] - token lex-string-body - _ (lex-str "\"") - ;; state &util/get-state - ;; :let [_ (prn 'POST state)] - ] - (return [::string token]))) - -(def ^:private lex-single-line-comment - (exec [_ (lex-str "##") - comment (lex-regex #"^([^\n]*)") - _ (lex-regex #"^(\n?)") - ;; :let [_ (prn 'comment comment)] - ] - (return [::comment comment]))) - -(def ^:private lex-multi-line-comment - (exec [_ (lex-str "#(") - ;; :let [_ (prn 'OPEN)] - ;; comment (lex-regex #"^(#\(.*\)#)") - comment (try-all-m [(lex-regex #"(?is)^((?!#\().)*?(?=\)#)") - (exec [pre (lex-regex #"(?is)^(.+?(?=#\())") - ;; :let [_ (prn 'PRE pre)] - [_ inner] lex-multi-line-comment - ;; :let [_ (prn 'INNER inner)] - post (lex-regex #"(?is)^(.+?(?=\)#))") - ;:let [_ (prn 'POST post)] - ] - (return (str pre "#(" inner ")#" post)))]) - ;; :let [_ (prn 'COMMENT comment)] - _ (lex-str ")#") - ;; :let [_ (prn 'CLOSE)] - ;; :let [_ (prn 'multi-comment comment)] - ] - (return [::comment comment]))) - -(def ^:private lex-tag - (exec [_ (lex-str "#") - token (lex-regex +ident-re+)] - (return [::tag token]))) - -(def ^:private lex-form - (exec [_ (try-m lex-white-space) - form (try-all-m [lex-boolean - lex-float - lex-int - lex-char - lex-string - lex-ident - lex-tag - lex-list - lex-tuple - lex-record - lex-single-line-comment - lex-multi-line-comment]) - _ (try-m lex-white-space)] - (return form))) - -(def lex-forms - (exec [forms (repeat-m lex-form)] - (return (filter #(match % - [::comment _] - false - _ - true) - forms)))) - -(def ^:private lex-list - (exec [_ (lex-str "(") - members lex-forms - _ (lex-str ")")] - (return [::list members]))) - -(def ^:private lex-tuple - (exec [_ (lex-str "[") - members lex-forms - _ (lex-str "]")] - (return [::tuple members]))) - -(def ^:private lex-record - (exec [_ (lex-str "{") - members lex-forms - _ (lex-str "}")] - (return [::record members]))) - -;; [Interface] -(defn lex [text] - (match (lex-forms text) - [::&util/ok [?state ?forms]] - (if (empty? ?state) - ?forms - (assert false (str "Unconsumed input: " ?state))) - - [::&util/failure ?message] - (assert false ?message))) diff --git a/src/lang/parser.clj b/src/lang/parser.clj deleted file mode 100644 index 34f3e70b4..000000000 --- a/src/lang/parser.clj +++ /dev/null @@ -1,230 +0,0 @@ -(ns lang.parser - (:require [clojure.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 - apply-m]] - [lexer :as &lexer] - [type :as &type]))) - -(declare parse-form) - -;; [Utils] -(defmacro ^:private defparser [name match return] - `(def ~name - (fn [[token# & left#]] - (match token# - ~match - (~return left#) - _# - (fail* (str "Unmatched token: " token#)))))) - -;; [Parsers] -(do-template [ ] - (defparser - [ ?value] - (return [ ( ?value)])) - - - ^:private parse-boolean ::&lexer/boolean ::boolean Boolean/parseBoolean - ^:private parse-int ::&lexer/int ::int Integer/parseInt - ^:private parse-float ::&lexer/float ::float Float/parseFloat - ) - -(defparser ^:private parse-char - [::&lexer/char ?value] - (return [::char (.charAt ?value 0)])) - -(defn ident->string [ident] - (match ident - [::&lexer/ident ?ident] - ?ident)) - -(defparser ^:private parse-ident - [::&lexer/ident ?ident] - (return [::ident ?ident])) - -(defparser ^:private parse-tuple - [::&lexer/tuple ?parts] - (exec [=parts (map-m (fn [arg] (apply-m parse-form (list arg))) - ?parts)] - (return [::tuple =parts]))) - -(defparser ^:private parse-record - [::&lexer/record ?parts] - (exec [=kvs (do (assert (even? (count ?parts))) - (map-m #(match % - ([[::&lexer/tag ?label] ?value] :seq) - (exec [=value (apply-m parse-form (list ?value))] - (return [?label =value]))) - (partition 2 ?parts)))] - (return [::record =kvs]))) - -(defparser ^:private parse-lambda - [::&lexer/list ([[::&lexer/ident "lambda"] [::&lexer/tuple ?args] ?body] :seq)] - (exec [=body (apply-m parse-form (list ?body))] - (return [::lambda (mapv ident->string ?args) =body]))) - -(defparser ^:private parse-def - [::&lexer/list ([[::&lexer/ident "def"] ?name ?body] :seq)] - (exec [=name (apply-m parse-form (list ?name)) - =body (apply-m parse-form (list ?body))] - (return [::def =name =body]))) - -(defparser ^:private parse-defmacro - [::&lexer/list ([[::&lexer/ident "defmacro"] ?name ?body] :seq)] - (exec [=name (apply-m parse-form (list ?name)) - =body (apply-m parse-form (list ?body))] - (return [::defmacro =name =body]))) - -(defparser ^:private parse-defdata - [::&lexer/list ([[::&lexer/ident "defdata"] ?type & ?cases] :seq)] - (exec [=type (apply-m parse-form (list ?type)) - =cases (map-m (fn [arg] - (match arg - [::&lexer/list ([[::&lexer/tag ?tag] ?data] :seq)] - (exec [=data (apply-m parse-form (list ?data))] - (return [::tagged ?tag =data])) - )) - ?cases)] - (return [::defdata =type =cases]))) - -(defparser ^:private parse-if - [::&lexer/list ([[::&lexer/ident "if"] ?test ?then ?else] :seq)] - (exec [=test (apply-m parse-form (list ?test)) - =then (apply-m parse-form (list ?then)) - =else (apply-m parse-form (list ?else))] - (return [::if =test =then =else]))) - -(defparser ^:private parse-do - [::&lexer/list ([[::&lexer/ident "do"] & ?exprs] :seq)] - (exec [=exprs (map-m #(apply-m parse-form (list %)) - ?exprs)] - (return [::do =exprs]))) - -(defparser ^:private parse-case - [::&lexer/list ([[::&lexer/ident "case"] ?variant & cases] :seq)] - (exec [=variant (apply-m parse-form (list ?variant)) - =branches (do (assert (even? (count cases))) - (map-m (fn [[destruct expr]] - (exec [=destruct (apply-m parse-form (list destruct)) - =expr (apply-m parse-form (list expr))] - (return [::case-branch =destruct =expr]))) - (partition 2 cases)))] - (return [::case =variant =branches]))) - -(defparser ^:private parse-let - [::&lexer/list ([[::&lexer/ident "let"] [::&lexer/ident ?label] ?value ?body] :seq)] - (exec [=value (apply-m parse-form (list ?value)) - =body (apply-m parse-form (list ?body))] - (return [::let ?label =value =body]))) - -(defparser ^:private parse-import - [::&lexer/list ([[::&lexer/ident "import"] [::&lexer/ident ?class]] :seq)] - (return [::import ?class])) - -(defparser ^:private parse-require - [::&lexer/list ([[::&lexer/ident "require"] [::&lexer/string ?file] [::&lexer/ident "as"] [::&lexer/ident ?alias]] :seq)] - (return [::require ?file ?alias])) - -(defparser ^:private parse-defclass - [::&lexer/list ([[::&lexer/ident "defclass"] [::&lexer/ident ?name] [::&lexer/tuple ?fields]] :seq)] - (let [fields (for [field ?fields] - (match field - [::&lexer/tuple ([[::&lexer/ident ?class] [::&lexer/ident ?field]] :seq)] - [?class ?field]))] - (return [::defclass ?name fields]))) - -(defparser ^:private parse-definterface - [::&lexer/list ([[::&lexer/ident "definterface"] [::&lexer/ident ?name] & ?members] :seq)] - (let [members (for [field ?members] - (match field - [::&lexer/list ([[::&lexer/ident ":"] [::&lexer/ident ?member] [::&lexer/list ([[::&lexer/ident "->"] [::&lexer/tuple ?inputs] ?output] :seq)]] :seq)] - [?member [(map ident->string ?inputs) (ident->string ?output)]]))] - (return [::definterface ?name members]))) - -(defparser ^:private parse-variant - ?token - (match ?token - [::&lexer/tag ?tag] - (return [::variant ?tag '()]) - - [::&lexer/list ([[::&lexer/tag ?tag] & ?data] :seq)] - (exec [=data (map-m #(apply-m parse-form (list %)) - ?data)] - (return [::variant ?tag =data])) - - _ - (fail (str "Unmatched token: " ?token)))) - -(defparser ^:private parse-get - [::&lexer/list ([[::&lexer/ident "get@"] [::&lexer/tag ?tag] ?record] :seq)] - (exec [=record (apply-m parse-form (list ?record))] - (return [::get ?tag =record]))) - -(defparser ^:private parse-remove - [::&lexer/list ([[::&lexer/ident "remove@"] [::&lexer/tag ?tag] ?record] :seq)] - (exec [=record (apply-m parse-form (list ?record))] - (return [::remove ?tag =record]))) - -(defparser ^:private parse-set - [::&lexer/list ([[::&lexer/ident "set@"] [::&lexer/tag ?tag] ?value ?record] :seq)] - (exec [=value (apply-m parse-form (list ?value)) - =record (apply-m parse-form (list ?record))] - (return [::set ?tag =value =record]))) - -(defparser ^:private parse-access - [::&lexer/list ([[::&lexer/ident "::"] ?object ?call] :seq)] - (exec [=object (apply-m parse-form (list ?object)) - =call (apply-m parse-form (list ?call))] - (return [::access =object =call]))) - -(defparser ^:private parse-string - [::&lexer/string ?string] - (return [::string ?string])) - -(defparser ^:private parse-fn-call - [::&lexer/list ([?f & ?args] :seq)] - (exec [=f (apply-m parse-form (list ?f)) - =args (map-m (fn [arg] (apply-m parse-form (list arg))) - ?args)] - (return [::fn-call =f =args]))) - -(def ^:private parse-form - (try-all-m [parse-boolean - parse-int - parse-float - parse-char - parse-string - parse-ident - parse-tuple - parse-record - parse-lambda - parse-def - parse-defmacro - parse-defdata - parse-if - parse-do - parse-case - parse-let - parse-variant - parse-get - parse-set - parse-remove - parse-access - parse-defclass - parse-definterface - parse-import - parse-require - parse-fn-call])) - -;; [Interface] -(defn parse [text] - (match ((repeat-m parse-form) text) - [::&util/ok [?state ?forms]] - (if (empty? ?state) - ?forms - (assert false (str "Unconsumed input: " (pr-str ?state)))) - - [::&util/failure ?message] - (assert false ?message))) diff --git a/src/lang/type.clj b/src/lang/type.clj deleted file mode 100644 index cfb404a21..000000000 --- a/src/lang/type.clj +++ /dev/null @@ -1,148 +0,0 @@ -(ns lang.type - (:refer-clojure :exclude [resolve]) - (:require [clojure.core.match :refer [match]] - [lang.util :as &util :refer [exec return* return fail fail* - repeat-m try-m try-all-m map-m - apply-m assert!]])) - -;; [Util] -(def ^:private success (return nil)) - -(defn ^:private resolve [id] - (fn [state] - (if-let [top+bottom (get-in state [::mappings id])] - [::&util/ok [state top+bottom]] - [::&util/failure (str "Unknown type-var: " id)]))) - -(defn ^:private update [id top bottom] - (fn [state] - (if-let [top+bottom (get-in state [::mappings id])] - [::&util/ok [(assoc-in state [::mappings id] [top bottom]) nil]] - [::&util/failure (str "Unknown type-var: " id)]))) - -;; [Interface] -(def +init+ {::counter 0 - ::mappings {}}) - -(def fresh-var - (fn [state] - (let [id (::counter state)] - [::&util/ok [(-> state - (update-in [::counter] inc) - (assoc-in [::mappings id] [::any ::nothing])) - [::var id]]]))) - -(defn fresh-function [num-args] - (exec [=args (map-m (constantly fresh-var) (range num-args)) - =return fresh-var - :let [=function [::function =args =return]]] - (return [=function =args =return]))) - -(defn solve [expected actual] - ;; (prn 'solve expected actual) - (match [expected actual] - [::any _] - success - - [_ ::nothing] - success - - [_ [::var ?id]] - (exec [[=top =bottom] (resolve ?id)] - (try-all-m [(exec [_ (solve expected =top)] - success) - (exec [_ (solve =top expected) - _ (solve expected =bottom) - _ (update ?id expected =bottom)] - success)])) - - [[::var ?id] _] - (exec [[=top =bottom] (resolve ?id)] - (try-all-m [(exec [_ (solve =bottom actual)] - success) - (exec [_ (solve actual =bottom) - _ (solve =top actual) - _ (update ?id =top actual)] - success)])) - - [[::primitive ?prim] _] - (let [as-obj (case ?prim - "boolean" [:lang.type/object "java.lang.Boolean" []] - "int" [:lang.type/object "java.lang.Integer" []] - "long" [:lang.type/object "java.lang.Long" []] - "char" [:lang.type/object "java.lang.Character" []] - "float" [:lang.type/object "java.lang.Float" []] - "double" [:lang.type/object "java.lang.Double" []])] - (solve as-obj actual)) - - [[::object ?eclass []] [::object ?aclass []]] - (if (.isAssignableFrom (Class/forName ?eclass) (Class/forName ?aclass)) - success - (fail (str "Can't solve types: " (pr-str expected actual)))) - - [_ _] - (fail (str "Can't solve types: " (pr-str expected actual))) - )) - -(defn pick-matches [methods args] - (if (empty? methods) - (fail "No matches.") - (try-all-m [(match (-> methods first second) - [::function ?args ?return] - (exec [_ (assert! (= (count ?args) (count args)) "Args-size doesn't match.") - _ (map-m (fn [[e a]] (solve e a)) (map vector ?args args))] - (return (first methods)))) - (pick-matches (rest methods) args)]))) - -(defn clean [type] - (match type - [::var ?id] - (exec [[=top =bottom] (resolve ?id)] - (clean =top)) - - [::function ?args ?return] - (exec [=args (map-m clean ?args) - =return (clean ?return)] - (return [::function =args =return])) - - ;; ::any - ;; (return [::object "java.lang.Object" []]) - - _ - (return type))) - -;; Java Reflection -(defn class->type [class] - (if-let [[_ base arr-level] (re-find #"^([^\[]+)(\[\])*$" - (str (if-let [pkg (.getPackage class)] - (str (.getName pkg) ".") - "") - (.getSimpleName class)))] - (if (= "void" base) - (return ::nothing) - (let [base* (case base - ("boolean" "byte" "short" "int" "long" "float" "double" "char") - [::primitive base] - ;; else - [::object base []])] - (if arr-level - (return (reduce (fn [inner _] - [::array inner]) - base* - (range (/ (count arr-level) 2.0)))) - (return base*))) - - ))) - -(defn method->type [method] - (exec [=args (map-m class->type (seq (.getParameterTypes method))) - =return (class->type (.getReturnType method))] - (return [::function (vec =args) =return]))) - -(defn return-type [func] - (match func - [::function _ ?return] - (return ?return) - - _ - (fail (str "Type is not a function: " (pr-str func))))) diff --git a/src/lang/util.clj b/src/lang/util.clj deleted file mode 100644 index 063dfa061..000000000 --- a/src/lang/util.clj +++ /dev/null @@ -1,168 +0,0 @@ -(ns lang.util - (:require [clojure.string :as string] - [clojure.core.match :refer [match]])) - -;; [Interface] -;; [Interface/Utils] -(defn fail* [message] - [::failure message]) - -(defn return* [state value] - [::ok [state value]]) - -;; [Interface/Monads] -(defn fail [message] - (fn [_] - [::failure message])) - -(defn return [value] - (fn [state] - [::ok [state value]])) - -(defn bind [m-value step] - #(let [inputs (m-value %)] - ;; (prn 'bind/inputs inputs) - (match inputs - [::ok [?state ?datum]] - ((step ?datum) ?state) - - [::failure _] - inputs))) - -(defmacro exec [steps return] - (assert (not= 0 (count steps)) "The steps can't be empty!") - (assert (= 0 (rem (count steps) 2)) "The number of steps must be even!") - (reduce (fn [inner [label computation]] - (case label - :let `(let ~computation ~inner) - ;; :when (assert false "Can't use :when") - :when `(if ~computation - ~inner - zero) - ;; else - `(bind ~computation (fn [~label] ~inner)))) - return - (reverse (partition 2 steps)))) - -;; [Interface/Combinators] -(defn try-m [monad] - (fn [state] - (match (monad state) - [::ok [?state ?datum]] - (return* ?state ?datum) - - [::failure _] - (return* state nil)))) - -(defn repeat-m [monad] - (fn [state] - (match (monad state) - [::ok [?state ?head]] - (do ;; (prn 'repeat-m/?state ?state) - (match ((repeat-m monad) ?state) - [::ok [?state* ?tail]] - (do ;; (prn 'repeat-m/?state* ?state*) - (return* ?state* (cons ?head ?tail))))) - - [::failure ?message] - (do ;; (println "Failed at last:" ?message) - (return* state '()))))) - -(defn try-all-m [monads] - (fn [state] - (if (empty? monads) - (fail* "No alternative worked!") - (let [output ((first monads) state)] - (match output - [::ok _] - output - :else - (if-let [monads* (seq (rest monads))] - ((try-all-m monads*) state) - output) - ))))) - -(defn map-m [f inputs] - (if (empty? inputs) - (return '()) - (exec [output (f (first inputs)) - outputs (map-m f (rest inputs))] - (return (conj outputs output))))) - -(defn reduce-m [f init inputs] - (if (empty? inputs) - (return init) - (exec [init* (f init (first inputs))] - (reduce-m f init* (rest inputs))))) - -(defn apply-m [monad call-state] - (fn [state] - ;; (prn 'apply-m monad call-state) - (let [output (monad call-state)] - ;; (prn 'apply-m/output output) - (match output - [::ok [?state ?datum]] - [::ok [state ?datum]] - - [::failure _] - output)))) - -(defn assert! [test message] - (if test - (return nil) - (fail message))) - -(defn comp-m [f-m g-m] - (exec [temp g-m] - (f-m temp))) - -(defn pass [m-value] - (fn [state] - m-value)) - -(def get-state - (fn [state] - (return* state state))) - -(defn within [slot monad] - (fn [state] - (let [=return (monad (get state slot))] - (match =return - [::ok [?state ?value]] - [::ok [(assoc state slot ?state) ?value]] - _ - =return)))) - -(defn ^:private normalize-char [char] - (case char - \* "_ASTER_" - \+ "_PLUS_" - \- "_DASH_" - \/ "_SLASH_" - \\ "_BSLASH_" - \_ "_UNDERS_" - \% "_PERCENT_" - \$ "_DOLLAR_" - \' "_QUOTE_" - \` "_BQUOTE_" - \@ "_AT_" - \^ "_CARET_" - \& "_AMPERS_" - \= "_EQ_" - \! "_BANG_" - \? "_QM_" - \: "_COLON_" - \; "_SCOLON_" - \. "_PERIOD_" - \, "_COMMA_" - \< "_LT_" - \> "_GT_" - \~ "_TILDE_" - ;; default - char)) - -(defn normalize-ident [ident] - (reduce str "" (map normalize-char ident))) - -(defonce loader (doto (-> (java.io.File. "./") .toURL vector into-array java.net.URLClassLoader.) - (->> (prn 'loader)))) -- cgit v1.2.3