diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/lux.clj | 15 | ||||
| -rw-r--r-- | src/lux/analyser.clj | 103 | ||||
| -rw-r--r-- | src/lux/compiler.clj | 157 | ||||
| -rw-r--r-- | src/lux/util.clj | 18 |
4 files changed, 165 insertions, 128 deletions
diff --git a/src/lux.clj b/src/lux.clj index 6efbcc207..dca7034c3 100644 --- a/src/lux.clj +++ b/src/lux.clj @@ -24,19 +24,10 @@ ;; TODO: Reinplement "if" as a macro on top of case. ;; TODO: - (let [source-code (slurp "source/test2.lux") - tokens (&lexer/lex source-code) - ;; _ (prn 'tokens tokens) - syntax (&parser/parse tokens) - ;; _ (prn 'syntax syntax) - ;; ann-syntax (&analyser/analyse "test2" syntax) - ;; _ (prn 'ann-syntax ann-syntax) - ;; class-data (&compiler/compile "test2" ann-syntax) - class-data (&compiler/compile "test2" syntax) - ;; _ (prn 'class-data class-data) - ] - ) + (&compiler/compile-all ["lux" "test2"]) + + ;; jar cvf test2.jar *.class test2 && java -cp "test2.jar" test2 ;; cd output && jar cvf test2.jar * && java -cp "test2.jar" test2 && cd .. ) diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index dd41f638d..179d2089e 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -4,7 +4,7 @@ [template :refer [do-template]]) [clojure.core.match :refer [match]] (lux [util :as &util :refer [exec return* return fail fail* - repeat-m try-m try-all-m map-m reduce-m + repeat-m exhaust-m try-m try-all-m map-m reduce-m apply-m within normalize-ident loader]] @@ -33,23 +33,26 @@ (defn ^:private define [name desc] (fn [state] [::&util/ok [(-> state - (assoc-in [:defs (:name state) name] desc) + (assoc-in [:modules (:name state) name] desc) (assoc-in [:defs-env name] (annotated [::global (:name state) name] (:type desc)))) nil]])) (defn ^:private define-fn [name desc] (fn [state] [::&util/ok [(-> state - (assoc-in [:defs (:name state) name] desc) + (assoc-in [:modules (:name state) name] desc) (assoc-in [:defs-env name] (annotated [::global-fn (:name state) name] (:type desc)))) nil]])) -(defn ^:private is-macro? [name] +(defn ^:private is-macro? [module 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)]])) + ;; (prn 'is-macro? name (get-in state [:modules module name :mode]) + ;; (get-in state [:modules module]) + ;; (get-in state [:modules])) + [::&util/ok [state (= (get-in state [:modules module name :mode]) ::macro)]])) (def ^:private next-local-idx (fn [state] @@ -63,18 +66,13 @@ (fn [state] [::&util/ok [state (-> state :env first)]])) -(defn ^:private in-scope? [scope] +(defn ^:private in-scope? [module name] (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]]) + (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 = name) (get-in state [:lambda-scope 0]))]]) )) (defn with-scope [scope body] @@ -184,8 +182,8 @@ [::&util/ok [?state ?value]] (do ;; (prn 'PRE-LAMBDA (:env state)) ;; (prn 'POST-LAMBDA (:env ?state) ?value) - (prn 'POST-LAMBDA1 (get-in ?state [:lambda-scope 0]) (-> ?state :env first :mappings)) - (prn 'POST-LAMBDA2 (get-in ?state [:lambda-scope 0]) (-> ?state :env first (update-in [:mappings] #(reduce dissoc % args-vars)) :mappings)) + ;; (prn 'POST-LAMBDA1 (get-in ?state [:lambda-scope 0]) (-> ?state :env first :mappings)) + ;; (prn 'POST-LAMBDA2 (get-in ?state [:lambda-scope 0]) (-> ?state :env first (update-in [:mappings] #(reduce dissoc % args-vars)) :mappings)) [::&util/ok [(-> ?state (update-in [:env] rest) ;; (update-in [:lambda-scope 1] inc) @@ -220,21 +218,25 @@ (fn [state] (or (if-let [[_ ?alias ?binding] (re-find #"^(.*)/(.*)$" ident)] (if-let [?module (get-in state [:deps ?alias])] - [::&util/ok [state (annotated [::global ?module ?binding] ::&type/nothing)]])) + (do (prn 'resolve '[_ ?alias ?binding] ident [:global ?module ?binding]) + [::&util/ok [state (annotated [::global ?module ?binding] ::&type/nothing)]]))) (let [[inner outer] (split-with #(nil? (get-in % [:mappings ident])) (:env state))] (cond (empty? inner) - (do (prn 'resolve/inner ident (get-in state [:lambda-scope 0])) + (do ;; (prn 'resolve/inner ident (get-in state [:lambda-scope 0])) + (prn 'resolve/env ident (-> state :env first :mappings (get ident))) [::&util/ok [state (-> state :env first :mappings (get ident))]]) (empty? outer) - (do (prn 'resolve/outer ident (get-in state [:lambda-scope 0])) + (do ;; (prn 'resolve/outer ident (get-in state [:lambda-scope 0])) (if-let [global|import (or (get-in state [:defs-env ident]) (get-in state [:imports ident]))] - [::&util/ok [state global|import]] - [::&util/failure (str "Unresolved identifier: " ident)])) + (do (prn 'resolve/global|import ident global|import) + [::&util/ok [state global|import]]) + (do (prn 'resolve/UNRESOLVED (str "Unresolved identifier: " ident)) + [::&util/failure (str "Unresolved identifier: " ident)]))) :else - (do (prn 'resolve/:else ident (get-in state [:lambda-scope 0])) + (do ;; (prn 'resolve/:else ident (get-in state [:lambda-scope 0])) (let [[=local inner*] (reduce (fn [[register new-inner] [frame scope]] (let [[register* frame*] (close-over scope ident register frame)] [register* (cons frame* new-inner)])) @@ -245,7 +247,8 @@ (iterate pop) (take (count inner)) reverse)))] - (prn 'resolve/inner* inner*) + ;; (prn 'resolve/inner* inner*) + (prn 'resolve/=local ident =local) [::&util/ok [(assoc state :env (concat inner* outer)) =local]]))))))) (defmacro ^:private defanalyser [name match return] @@ -480,7 +483,7 @@ (exec [=class (full-class-name ?class) =classes (map-m extract-jvm-param ?classes) =return (lookup-virtual-method (Class/forName =class) ?method =classes) - :let [_ (prn 'analyse-jvm-invokevirtual ?class ?method =classes '-> =return)] + ;; :let [_ (prn 'analyse-jvm-invokevirtual ?class ?method =classes '-> =return)] ;; =return =return =object (analyse-form* ?object) =args (map-m analyse-form* ?args)] @@ -550,39 +553,39 @@ ;; (prn '->token x) (match x [::&parser/bool ?bool] - (doto (.newInstance (.loadClass @loader "test2.Variant1")) + (doto (.newInstance (.loadClass @loader "lux.Variant1")) (-> .-tag (set! "Bool")) (-> .-_1 (set! ?bool))) [::&parser/int ?int] - (doto (.newInstance (.loadClass @loader "test2.Variant1")) + (doto (.newInstance (.loadClass @loader "lux.Variant1")) (-> .-tag (set! "Int")) (-> .-_1 (set! ?int))) [::&parser/real ?real] - (doto (.newInstance (.loadClass @loader "test2.Variant1")) + (doto (.newInstance (.loadClass @loader "lux.Variant1")) (-> .-tag (set! "Real")) (-> .-_1 (set! ?real))) [::&parser/char ?elem] - (doto (.newInstance (.loadClass @loader "test2.Variant1")) + (doto (.newInstance (.loadClass @loader "lux.Variant1")) (-> .-tag (set! "Char")) (-> .-_1 (set! ?elem))) [::&parser/text ?text] - (doto (.newInstance (.loadClass @loader "test2.Variant1")) + (doto (.newInstance (.loadClass @loader "lux.Variant1")) (-> .-tag (set! "Text")) (-> .-_1 (set! ?text))) [::&parser/tag ?tag] - (doto (.newInstance (.loadClass @loader "test2.Variant1")) + (doto (.newInstance (.loadClass @loader "lux.Variant1")) (-> .-tag (set! "Tag")) (-> .-_1 (set! ?tag))) [::&parser/ident ?ident] - (doto (.newInstance (.loadClass @loader "test2.Variant1")) + (doto (.newInstance (.loadClass @loader "lux.Variant1")) (-> .-tag (set! "Ident")) (-> .-_1 (set! ?ident))) [::&parser/tuple ?elems] - (doto (.newInstance (.loadClass @loader "test2.Variant1")) + (doto (.newInstance (.loadClass @loader "lux.Variant1")) (-> .-tag (set! "Tuple")) (-> .-_1 (set! (->tokens ?elems)))) [::&parser/form ?elems] - (doto (.newInstance (.loadClass @loader "test2.Variant1")) + (doto (.newInstance (.loadClass @loader "lux.Variant1")) (-> .-tag (set! "Form")) (-> .-_1 (set! (->tokens ?elems)))) )) @@ -590,11 +593,11 @@ (defn ->tokens [xs] (reduce (fn [tail x] ;; (prn 'tail (.-tag tail) 'x x) - (doto (.newInstance (.loadClass @loader "test2.Variant2")) + (doto (.newInstance (.loadClass @loader "lux.Variant2")) (-> .-tag (set! "Cons")) (-> .-_1 (set! (->token x))) (-> .-_2 (set! tail)))) - (doto (.newInstance (.loadClass @loader "test2.Variant0")) + (doto (.newInstance (.loadClass @loader "lux.Variant0")) (-> .-tag (set! "Nil"))) (reverse xs))) @@ -622,23 +625,25 @@ (defanalyser analyse-call [::&parser/form ([?fn & ?args] :seq)] (exec [=fn (analyse-form* ?fn) - :let [_ (prn 'analyse-call/=fn =fn)]] + ;; :let [_ (prn 'analyse-call/=fn =fn)] + ] (match (:form =fn) [::global-fn ?module ?name] - (exec [macro? (is-macro? ?fn) - scoped? (in-scope? ?fn) - :let [_ (prn 'analyse-call [:global-fn ?module ?name] macro? scoped?)]] + (exec [macro? (is-macro? ?module ?name) + scoped? (in-scope? ?module ?name) + :let [_ (prn 'analyse-call [:global-fn ?module ?name] macro? scoped?)] + ;; :let [_ (prn 'analyse-call [:global-fn ?module ?name] macro? scoped?)] + ] (if (and macro? (not scoped?)) (let [macro-class (str ?module "$" (normalize-ident ?name)) transformed (-> (.loadClass @loader macro-class) .newInstance (.apply (->tokens ?args)) ->clojure-token) - _ (prn 'analyse-call/transformed transformed)] - (-> (.loadClass @loader macro-class) - .newInstance - (.apply (->tokens ?args)) - ->clojure-token + _ (prn 'analyse-call/macro-raw ?args) + _ (prn 'analyse-call/transformed transformed) + ] + (-> transformed analyse-form*)) (exec [=args (map-m analyse-form* ?args) :let [[needs-num =return-type] (match (:type =fn) @@ -1016,15 +1021,19 @@ (defanalyser analyse-defmacro [::&parser/form ([[::&parser/ident "defmacro"] [::&parser/form ([[::&parser/ident ?name] [::&parser/ident ?tokens]] :seq)] ?value] :seq)] (exec [[=function =tokens =return] (within :types (&type/fresh-function 1)) + :let [_ (prn 'analyse-defmacro/_1 ?name)] =value (with-scope ?name (with-scoped-name ?name =function (with-local ?tokens =tokens (analyse-form* ?value)))) + :let [_ (prn 'analyse-defmacro/_2 ?name)] =function (within :types (exec [_ (&type/solve =return (:type =value))] (&type/clean =function))) + :let [_ (prn 'analyse-defmacro/_3 ?name)] _ (define-fn ?name {:mode ::macro :access ::public - :type =function})] + :type =function}) + :let [_ (prn 'analyse-defmacro/_4 ?name)]] (return (annotated [::def [?name (list ?tokens)] =value] ::&type/nothing)))) (defanalyser analyse-lambda diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index 5b901c08e..07a1df1a4 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -5,7 +5,7 @@ [template :refer [do-template]]) [clojure.core.match :refer [match]] (lux [util :as &util :refer [exec return* return fail fail* - repeat-m try-m try-all-m map-m reduce-m + repeat-m exhaust-m try-m try-all-m map-m reduce-m apply-m within normalize-ident loader reset-loader!]] @@ -22,6 +22,8 @@ (declare compile-form compile) +(def +prefix+ "lux") + ;; [Utils/General] (defn ^:private write-file [file data] ;; (println 'write-file file (alength data)) @@ -33,20 +35,11 @@ (defn ^:private write-class [name data] (write-file (str "output/" name ".class") data)) -(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)) - ;; (-> (java.io.File. "./") .toURL vector into-array java.net.URLClassLoader. (.loadClass "test2/Function")) - )) +(defn load-class! [name file-name] + (.loadClass @loader name)) -(def ^:private +variant-class+ "test2.Variant") -(def ^:private +tuple-class+ "test2.Tuple") +(def ^:private +variant-class+ (str +prefix+ ".Variant")) +(def ^:private +tuple-class+ (str +prefix+ ".Tuple")) (defmacro ^:private defcompiler [name match body] `(defn ~name [~'*state*] @@ -117,7 +110,7 @@ (->type-signature +variant-class+) [::&type/function ?args ?return] - (->java-sig [::&type/object "test2/Function" []]))) + (->java-sig [::&type/object (str +prefix+ "/Function") []]))) (defn ^:private method->sig [method] (match method @@ -168,7 +161,7 @@ [::&analyser/tuple ?elems] (let [;; _ (prn 'compile-tuple (count ?elems)) num-elems (count ?elems)] - (let [tuple-class (str "test2/Tuple" num-elems)] + (let [tuple-class (str (str +prefix+ "/Tuple") num-elems)] (doto *writer* (.visitTypeInsn Opcodes/NEW tuple-class) (.visitInsn Opcodes/DUP) @@ -225,7 +218,7 @@ (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)))))) + (.visitMethodInsn *writer* Opcodes/INVOKEINTERFACE (str +prefix+ "/Function") "apply" apply-signature)))))) (defcompiler ^:private compile-static-call [::&analyser/static-call ?needs-num ?fn ?args] @@ -243,7 +236,7 @@ (->> (doseq [arg (take ?needs-num ?args)]))) (.visitMethodInsn Opcodes/INVOKESTATIC call-class "impl" impl-sig) (-> (doto (do (compile-form (assoc *state* :form arg))) - (.visitMethodInsn Opcodes/INVOKEINTERFACE "test2/Function" "apply" apply-signature)) + (.visitMethodInsn Opcodes/INVOKEINTERFACE (str +prefix+ "/Function") "apply" apply-signature)) (->> (doseq [arg (drop ?needs-num ?args)]))))) (let [counter-sig "I" init-signature (str "(" (apply str counter-sig (repeat (dec ?needs-num) arg-sig)) ")" "V")] @@ -346,7 +339,7 @@ (defcompiler ^:private compile-jvm-invokevirtual [::&analyser/jvm-invokevirtual ?class ?method ?classes ?object ?args] - (let [_ (prn 'compile-jvm-invokevirtual [?class ?method ?classes] '-> *type*) + (let [;; _ (prn 'compile-jvm-invokevirtual [?class ?method ?classes] '-> *type*) method-sig (str "(" (reduce str "" (map ->type-signature ?classes)) ")" (->java-sig *type*))] (compile-form (assoc *state* :form ?object)) (.visitTypeInsn *writer* Opcodes/CHECKCAST (->class ?class)) @@ -760,7 +753,7 @@ (.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"])) + current-class nil "java/lang/Object" (into-array [(str +prefix+ "/Function")])) (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "_datum" self-sig nil nil) (-> (.visitField (+ Opcodes/ACC_PRIVATE Opcodes/ACC_FINAL) "_counter" counter-sig nil nil) (->> (when (not= 0 num-captured)))) @@ -853,7 +846,7 @@ (.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"])) + current-class nil "java/lang/Object" (into-array [(str +prefix+ "/Function")])) (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_datum" datum-sig nil nil) (doto (.visitEnd))) (-> (.visitMethod Opcodes/ACC_PUBLIC "<clinit>" "()V" nil nil) @@ -900,7 +893,7 @@ (defcompiler ^:private compile-lambda [::&analyser/lambda ?scope ?frame ?args ?body] - (let [_ (prn '[?scope ?frame] ?scope ?frame ?args) + (let [;; _ (prn '[?scope ?frame] ?scope ?frame ?args) num-args (count ?args) ;; outer-class (->class *class-name*) clo-field-sig (->type-signature "java.lang.Object") @@ -923,7 +916,7 @@ ;; _ (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"])) + current-class nil "java/lang/Object" (into-array [(str +prefix+ "/Function")])) (-> (doto (.visitField (+ Opcodes/ACC_PRIVATE Opcodes/ACC_FINAL) captured-name clo-field-sig nil nil) (.visitEnd)) (->> (let [captured-name (str "__" ?captured-id)]) @@ -1178,50 +1171,76 @@ (assert false (str "Can't compile: " (pr-str (:form state))))))) ;; [Interface] -(defn compile [class-name inputs] +(def !state (atom nil)) + +;; "map" {:mode :lux.analyser/function, +;; :access :lux.analyser/public, +;; :type [:lux.type/function (:lux.type/any :lux.type/any) :lux.type/any]} + +;; "map" {:form [:lux.analyser/global-fn "lux" "map"], +;; :type [:lux.type/function (:lux.type/any :lux.type/any) :lux.type/any]} + +(defn compile [module-name inputs] ;; (prn 'inputs inputs) - (reset-loader!) - (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 (first (:forms ?state)))))) - - [::&util/failure ?message] - (assert false ?message)) - ;;; - (.visitEnd =class) - (let [bytecode (.toByteArray =class)] - (write-class class-name 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]))) - ;; ) - ) + (if-let [module (get-in @!state [:modules module-name])] + (assert false "Can't redefine a module!") + (do (reset-loader!) + (let [init-state (let [+prelude-module+ "lux" + init-state (assoc @!state :name module-name, :forms inputs, :defs-env {})] + (if (= +prelude-module+ module-name) + init-state + (assoc init-state :defs-env (into {} (for [[?name ?desc] (get-in init-state [:modules +prelude-module+])] + (case (:mode ?desc) + ::&analyser/constant + [?name {:form [::&analyser/global +prelude-module+ ?name] + :type (:type ?desc)}] + (::&analyser/function ::&analyser/macro) + [?name {:form [::&analyser/global-fn +prelude-module+ ?name] + :type (:type ?desc)}])))))) + =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) + (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER) + (->class module-name) nil "java/lang/Object" nil)) + compiler-state {:class-name module-name + :writer =class + :form nil + :parent nil} + new-state (match ((exhaust-m + (&analyser/with-scope module-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)))) + init-state) + [::&util/ok [?state ?forms]] + (if (empty? (:forms ?state)) + (do (reset! !state ?state) + ?state) + (assert false (str "Unconsumed input: " (pr-str (first (:forms ?state)))))) + + [::&util/failure ?message] + (assert false ?message))] + (.visitEnd =class) + (let [bytecode (.toByteArray =class)] + (write-class module-name bytecode) + (load-class! (string/replace module-name #"/" ".") (str module-name ".class")) + bytecode) + new-state + )))) + +(defn compile-file [name] + (->> (slurp (str "source/" name ".lux")) + &lexer/lex + &parser/parse + (compile name))) + +(defn compile-all [files] + (reset! !state {:name nil + :forms nil + :modules {} + :deps {} + :imports {} + :defs-env {} + :lambda-scope [[] 0] + :env (list (&analyser/fresh-env 0)) + :types &type/+init+}) + (dorun (map compile-file files))) diff --git a/src/lux/util.clj b/src/lux/util.clj index 757648c31..3662a4ea5 100644 --- a/src/lux/util.clj +++ b/src/lux/util.clj @@ -64,6 +64,24 @@ (do ;; (println "Failed at last:" ?message) (return* state '()))))) +(defn exhaust-m [monad] + (fn [state] + (let [result (monad state)] + (match result + [::ok [?state ?head]] + (if (empty? (:forms ?state)) + (return* ?state (list ?head)) + (let [result* ((exhaust-m monad) ?state)] + (match result* + [::ok [?state* ?tail]] + (return* ?state* (cons ?head ?tail)) + + _ + result*))) + + _ + result)))) + (defn try-all-m [monads] (fn [state] (if (empty? monads) |