diff options
author | Eduardo Julian | 2015-01-26 18:49:45 -0400 |
---|---|---|
committer | Eduardo Julian | 2015-01-26 18:49:45 -0400 |
commit | 713adb2027e13748c2ba50fb6bd97bc27d33b06e (patch) | |
tree | 4115d1f44eaf6f8d9de2c2548924b993d71e4136 | |
parent | 33aadce096a947300a2531940efc962c979542da (diff) |
[Working on]
- Almost finished rebuilding lambda syntax so it always has local names and only takes 1 argument.
-rw-r--r-- | source/lux.lux | 495 | ||||
-rw-r--r-- | src/lux/analyser.clj | 224 | ||||
-rw-r--r-- | src/lux/type.clj | 9 |
3 files changed, 437 insertions, 291 deletions
diff --git a/source/lux.lux b/source/lux.lux index 2b008f95f..29d7f3f5c 100644 --- a/source/lux.lux +++ b/source/lux.lux @@ -1,261 +1,284 @@ ## Base interfaces & classes (jvm:interface Function - (: apply (-> [java.lang.Object] java.lang.Object))) + (: apply (-> [java.lang.Object] java.lang.Object))) (jvm:class Tuple0 java.lang.Object - []) + []) (jvm:class Tuple1 java.lang.Object - [[java.lang.Object _1]]) + [[java.lang.Object _1]]) (jvm:class Tuple2 java.lang.Object - [[java.lang.Object _1] [java.lang.Object _2]]) + [[java.lang.Object _1] [java.lang.Object _2]]) (jvm:class Tuple3 java.lang.Object - [[java.lang.Object _1] [java.lang.Object _2] - [java.lang.Object _3]]) + [[java.lang.Object _1] [java.lang.Object _2] + [java.lang.Object _3]]) (jvm:class Tuple4 java.lang.Object - [[java.lang.Object _1] [java.lang.Object _2] - [java.lang.Object _3] [java.lang.Object _4]]) + [[java.lang.Object _1] [java.lang.Object _2] + [java.lang.Object _3] [java.lang.Object _4]]) (jvm:class Tuple5 java.lang.Object - [[java.lang.Object _1] [java.lang.Object _2] - [java.lang.Object _3] [java.lang.Object _4] - [java.lang.Object _5]]) + [[java.lang.Object _1] [java.lang.Object _2] + [java.lang.Object _3] [java.lang.Object _4] + [java.lang.Object _5]]) (jvm:class Tuple6 java.lang.Object - [[java.lang.Object _1] [java.lang.Object _2] - [java.lang.Object _3] [java.lang.Object _4] - [java.lang.Object _5] [java.lang.Object _6]]) + [[java.lang.Object _1] [java.lang.Object _2] + [java.lang.Object _3] [java.lang.Object _4] + [java.lang.Object _5] [java.lang.Object _6]]) (jvm:class Tuple7 java.lang.Object - [[java.lang.Object _1] [java.lang.Object _2] - [java.lang.Object _3] [java.lang.Object _4] - [java.lang.Object _5] [java.lang.Object _6] - [java.lang.Object _7]]) + [[java.lang.Object _1] [java.lang.Object _2] + [java.lang.Object _3] [java.lang.Object _4] + [java.lang.Object _5] [java.lang.Object _6] + [java.lang.Object _7]]) (jvm:class Tuple8 java.lang.Object - [[java.lang.Object _1] [java.lang.Object _2] - [java.lang.Object _3] [java.lang.Object _4] - [java.lang.Object _5] [java.lang.Object _6] - [java.lang.Object _7] [java.lang.Object _8]]) + [[java.lang.Object _1] [java.lang.Object _2] + [java.lang.Object _3] [java.lang.Object _4] + [java.lang.Object _5] [java.lang.Object _6] + [java.lang.Object _7] [java.lang.Object _8]]) (jvm:class Variant java.lang.Object - [[java.lang.String tag]]) + [[java.lang.String tag]]) (jvm:class Variant0 lux.Variant - []) + []) (jvm:class Variant1 lux.Variant - [[java.lang.Object _1]]) + [[java.lang.Object _1]]) (jvm:class Variant2 lux.Variant - [[java.lang.Object _1] [java.lang.Object _2]]) + [[java.lang.Object _1] [java.lang.Object _2]]) (jvm:class Variant3 lux.Variant - [[java.lang.Object _1] [java.lang.Object _2] - [java.lang.Object _3]]) + [[java.lang.Object _1] [java.lang.Object _2] + [java.lang.Object _3]]) (jvm:class Variant4 lux.Variant - [[java.lang.Object _1] [java.lang.Object _2] - [java.lang.Object _3] [java.lang.Object _4]]) + [[java.lang.Object _1] [java.lang.Object _2] + [java.lang.Object _3] [java.lang.Object _4]]) (jvm:class Variant5 lux.Variant - [[java.lang.Object _1] [java.lang.Object _2] - [java.lang.Object _3] [java.lang.Object _4] - [java.lang.Object _5]]) + [[java.lang.Object _1] [java.lang.Object _2] + [java.lang.Object _3] [java.lang.Object _4] + [java.lang.Object _5]]) (jvm:class Variant6 lux.Variant - [[java.lang.Object _1] [java.lang.Object _2] - [java.lang.Object _3] [java.lang.Object _4] - [java.lang.Object _5] [java.lang.Object _6]]) + [[java.lang.Object _1] [java.lang.Object _2] + [java.lang.Object _3] [java.lang.Object _4] + [java.lang.Object _5] [java.lang.Object _6]]) (jvm:class Variant7 lux.Variant - [[java.lang.Object _1] [java.lang.Object _2] - [java.lang.Object _3] [java.lang.Object _4] - [java.lang.Object _5] [java.lang.Object _6] - [java.lang.Object _7]]) + [[java.lang.Object _1] [java.lang.Object _2] + [java.lang.Object _3] [java.lang.Object _4] + [java.lang.Object _5] [java.lang.Object _6] + [java.lang.Object _7]]) (jvm:class Variant8 lux.Variant - [[java.lang.Object _1] [java.lang.Object _2] - [java.lang.Object _3] [java.lang.Object _4] - [java.lang.Object _5] [java.lang.Object _6] - [java.lang.Object _7] [java.lang.Object _8]]) + [[java.lang.Object _1] [java.lang.Object _2] + [java.lang.Object _3] [java.lang.Object _4] + [java.lang.Object _5] [java.lang.Object _6] + [java.lang.Object _7] [java.lang.Object _8]]) ## Base functions & macros -(def (id x) - x) - -(def (fold f init values) - (case values - #Nil - init - (#Cons x xs) - (fold f (f init x) xs))) - -(def (cons tail head) - (#Cons head tail)) - -(def (reverse list) - (fold cons #Nil list)) - -(annotate list Macro) -(def (list xs) - (fold (lambda [tail head] - (#Form (#Cons (#Tag "Cons") - (#Cons head - (#Cons tail #Nil))))) - (#Tag "Nil") - (reverse xs))) - -(def (++ xs ys) - (case xs - #Nil - ys - - (#Cons x xs*) - (#Cons x (++ xs* ys)))) - -(def (map f xs) - (case xs - #Nil - #Nil - - (#Cons x xs*) - (#Cons (f x) (map f xs*)))) - -(def (untemplate-list untemplate tokens) - (case tokens - #Nil - (#Tag "Nil") - - (#Cons token tokens') - (#Form (list (#Tag "Cons") (untemplate token) (untemplate-list untemplate tokens'))))) - -(def (untemplate token) - (case token - (#Bool elem) - (#Form (list (#Tag "Bool") (#Bool elem))) - - (#Int elem) - (#Form (list (#Tag "Int") (#Int elem))) - - (#Real elem) - (#Form (list (#Tag "Real") (#Real elem))) - - (#Char elem) - (#Form (list (#Tag "Char") (#Char elem))) - - (#Text elem) - (#Form (list (#Tag "Text") (#Text elem))) - - (#Tag elem) - (#Form (list (#Tag "Tag") (#Text elem))) - - (#Ident elem) - (#Form (list (#Tag "Ident") (#Text elem))) - - (#Form (#Cons (#Ident "~") (#Cons unquoted #Nil))) - unquoted - - (#Tuple elems) - (#Form (list (#Tag "Tuple") (untemplate-list untemplate elems))) - - (#Form elems) - (#Form (list (#Tag "Form") (untemplate-list untemplate elems))) - )) - - -## I/O -(def (print x) - (jvm:invokevirtual java.io.PrintStream "print" [Object] - (jvm:getstatic System out) [x])) - -(def (println x) - (jvm:invokevirtual java.io.PrintStream "println" [Object] - (jvm:getstatic System out) [x])) - -(annotate ' Macro) -(def (' form) - (case form - (#Cons token #Nil) - (untemplate token))) - -(def (+ x y) - (jvm:iadd x y)) - -(def inc (+ 1)) - -(def length (fold (lambda [l x] (inc l)) 0)) - -(def (rem dividend divisor) - (jvm:irem dividend divisor)) - -(def (= x y) - (jvm:invokevirtual Object "equals" [Object] - x [y])) - -(def (pairs list) - (case list - (#Cons x (#Cons y list*)) - (#Cons [x y] (pairs list*)) - - _ - #Nil)) - -(def (show x) - (jvm:invokevirtual Object "toString" [] - x [])) - -(def (concat t1 t2) - (jvm:invokevirtual String "concat" [String] - t1 [t2])) - -(def (range from to) - (if (= from to) - #Nil - (#Cons from (range (inc from) to)))) - -(def (text->list text) - (let length (jvm:invokevirtual String "length" [] - text []) - (map (lambda [idx] - (jvm:invokevirtual String "charAt" [int] - text [idx])) - (range 0 length)))) - -(def (enumerate list) - (case (fold (lambda [state x] - (case state - [idx list'] - [(inc idx) (#Cons [idx x] list')])) - [0 #Nil] - list) - [_ list'] - (reverse list'))) - -(def list-map #Nil) - -(def (put key val map) - (case map - #Nil - (#Cons [key val] map) - - (#Cons [?key ?val] map') - (if (= key ?key) - (#Cons [?key val] map') - (#Cons [?key ?val] (put key val map'))))) - -(def (get key map) - (case map - #Nil - #None - - (#Cons [?key ?val] map') - (if (= key ?key) - (#Some ?val) - (get key map')))) - -(def (show-kv kv) - (case kv - [?key ?val] - (fold concat "" (list "#" ?key " " (show ?val))))) - -(def (interpose elem list) - (case list - (#Cons x (#Cons y list')) - (#Cons x (#Cons elem (#Cons y list'))) - - _ - list)) - -(def (show-list xs) - (case xs - #Nil - "#Nil" - (#Cons x xs') - (fold concat "" (list "(#Cons " (show x) " " (show-list xs') ")")))) +(def' id + (lambda' id x + x)) + +(def' + (lambda' + x (lambda' _ y (jvm:iadd x y)))) + +(def' fold + (lambda' fold f + (lambda' _ init + (lambda' _ values + (case values + #Nil + init + (#Cons x xs) + (fold f (f init x) xs) + ))))) + +#( + (def' id (lambda [x] x)) + + (def' + (lambda [x y] (jvm:iadd x y))) + + (def (fold f init values) + (case values + #Nil + init + (#Cons x xs)x + (fold f (f init x) xs))) + + (def (cons tail head) + (#Cons head tail)) + + (def (reverse list) + (fold cons #Nil list)) + + (annotate list Macro) + (def (list xs) + (fold (lambda' tail + (lambda' head + (#Form (#Cons (#Tag "Cons") + (#Cons head + (#Cons tail #Nil)))))) + (#Tag "Nil") + (reverse xs))) + + (def (++ xs ys) + (case xs + #Nil + ys + + (#Cons x xs*) + (#Cons x (++ xs* ys)))) + + (def (map f xs) + (case xs + #Nil + #Nil + + (#Cons x xs*) + (#Cons (f x) (map f xs*)))) + + (def (untemplate-list untemplate tokens) + (case tokens + #Nil + (#Tag "Nil") + + (#Cons token tokens') + (#Form (list (#Tag "Cons") (untemplate token) (untemplate-list untemplate tokens'))))) + + (def (untemplate token) + (case token + (#Bool elem) + (#Form (list (#Tag "Bool") (#Bool elem))) + + (#Int elem) + (#Form (list (#Tag "Int") (#Int elem))) + + (#Real elem) + (#Form (list (#Tag "Real") (#Real elem))) + + (#Char elem) + (#Form (list (#Tag "Char") (#Char elem))) + + (#Text elem) + (#Form (list (#Tag "Text") (#Text elem))) + + (#Tag elem) + (#Form (list (#Tag "Tag") (#Text elem))) + + (#Ident elem) + (#Form (list (#Tag "Ident") (#Text elem))) + + (#Form (#Cons (#Ident "~") (#Cons unquoted #Nil))) + unquoted + + (#Tuple elems) + (#Form (list (#Tag "Tuple") (untemplate-list untemplate elems))) + + (#Form elems) + (#Form (list (#Tag "Form") (untemplate-list untemplate elems))) + )) + + + ## I/O + (def (print x) + (jvm:invokevirtual java.io.PrintStream "print" [Object] + (jvm:getstatic System out) [x])) + + (def (println x) + (jvm:invokevirtual java.io.PrintStream "println" [Object] + (jvm:getstatic System out) [x])) + + (annotate ' Macro) + (def (' form) + (case form + (#Cons token #Nil) + (untemplate token))) + + (def (+ x y) + (jvm:iadd x y)) + + (def inc (+ 1)) + + (def length (fold (lambda' l (lambda' x (inc l))) 0)) + + (def (rem dividend divisor) + (jvm:irem dividend divisor)) + + (def (= x y) + (jvm:invokevirtual Object "equals" [Object] + x [y])) + + (def (pairs list) + (case list + (#Cons x (#Cons y list*)) + (#Cons [x y] (pairs list*)) + + _ + #Nil)) + + (def (show x) + (jvm:invokevirtual Object "toString" [] + x [])) + + (def (concat t1 t2) + (jvm:invokevirtual String "concat" [String] + t1 [t2])) + + (def (range from to) + (if (= from to) + #Nil + (#Cons from (range (inc from) to)))) + + (def (text->list text) + (let length (jvm:invokevirtual String "length" [] + text []) + (map (lambda' idx + (jvm:invokevirtual String "charAt" [int] + text [idx])) + (range 0 length)))) + + (def (enumerate list) + (case (fold (lambda' state + (lambda' x + (case state + [idx list'] + [(inc idx) (#Cons [idx x] list')]))) + [0 #Nil] + list) + [_ list'] + (reverse list'))) + + (def list-map #Nil) + + (def (put key val map) + (case map + #Nil + (#Cons [key val] map) + + (#Cons [?key ?val] map') + (if (= key ?key) + (#Cons [?key val] map') + (#Cons [?key ?val] (put key val map'))))) + + (def (get key map) + (case map + #Nil + #None + + (#Cons [?key ?val] map') + (if (= key ?key) + (#Some ?val) + (get key map')))) + + (def (show-kv kv) + (case kv + [?key ?val] + (fold concat "" (list "#" ?key " " (show ?val))))) + + (def (interpose elem list) + (case list + (#Cons x (#Cons y list')) + (#Cons x (#Cons elem (#Cons y list'))) + + _ + list)) + + (def (show-list xs) + (case xs + #Nil + "#Nil" + (#Cons x xs') + (fold concat "" (list "(#Cons " (show x) " " (show-list xs') ")")))) + + )# diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index d2c64c8df..54ea1f46b 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -24,6 +24,7 @@ :inner-closures 0 :counter 0 :mappings {} + :mappings/closure {} :closure/id 0}) (def ^:private module-name @@ -126,14 +127,21 @@ ^:private with-lets with-let ) -(defn with-lambda [args body] +(def captured-vars + (fn [state] + [::&util/ok [state (-> state ::local-envs first :mappings/closure)]])) + +(defn with-lambda [self self-type arg arg-type body] (fn [state] (let [top (-> state ::local-envs first) scope* (str (:name top) "$" (str (:inner-closures top))) body* (with-env scope* - (with-lets args - (exec [=return body] - (return [scope* =return]))))] + (with-local self (annotated [::self scope* []] self-type) + (with-let arg arg-type + (exec [=return body + =next next-local-idx + =captured captured-vars] + (return [scope* =next =captured =return])))))] (body* (update-in state [::local-envs] #(cons (update-in (first %) [:inner-closures] inc) (rest %)))) ))) @@ -142,14 +150,17 @@ (let [register* (annotated [::captured scope (:closure/id frame) register] (:type register))] [register* (-> frame (update-in [:closure/id] inc) - (assoc-in [:mappings ident] register*))])) + (assoc-in [:mappings/closure ident] register*))])) (defn ^:private resolve [ident] (fn [state] + (prn 'resolve ident) (let [[top & stack*] (::local-envs state)] - (if-let [=bound (get-in top [:mappings ident])] + (if-let [=bound (or (get-in top [:mappings ident]) + (get-in top [:mappings/closure ident]))] [::&util/ok [state (list =bound)]] - (let [[inner outer] (split-with #(-> % :mappings (contains? ident) not) stack*)] + (let [no-binding? #(and (-> % :mappings (contains? ident) not) (-> % :mappings/closure (contains? ident) not)) + [inner outer] (split-with no-binding? stack*)] (if (empty? outer) (if-let [global|import (get-in state [::global-env ident])] [::&util/ok [state (list global|import)]] @@ -157,7 +168,9 @@ (let [[=local inner*] (reduce (fn [[register new-inner] frame] (let [[register* frame*] (close-over (:name frame) ident register frame)] [register* (cons frame* new-inner)])) - [(-> outer first :mappings (get ident)) '()] + [(or (get-in (first outer) [:mappings ident]) + (get-in (first outer) [:mappings/closure ident])) + '()] (reverse (cons top inner)))] [::&util/ok [(assoc state ::local-envs (concat inner* outer)) (list =local)]]) )) @@ -619,47 +632,125 @@ (analyse-ast ?body))] (return (list (annotated [::let idx ?label =value =body] (:type =body)))))) -(defn ^:private analyse-lambda [analyse-ast ?args ?body] - (exec [?args (map-m extract-ident ?args) - [=function =args =return] (within ::types (&type/fresh-function (count ?args))) - [=scope =body] (with-lambda (map vector ?args =args) - (analyse-ast ?body)) - =function (within ::types (exec [_ (&type/solve =return (:type =body))] - (&type/clean =function)))] - (return (list (annotated [::lambda =scope ?args =body] =function))))) - -(defn ^:private analyse-def [analyse-ast ?usage ?value] - (match ?usage - [::&parser/ident ?name] - (exec [:let [scoped-name (str "def_" ?name)] - [=value] (with-env (str "def_" ?name) - (analyse-ast ?value)) - _ (annotate ?name ::constant ::public false (:type =value)) - _ (define ?name)] - (return (list (annotated [::def ?name =value] ::&type/nothing)))) +(defn ^:private raise-tree-bindings [outer-scope to-raise ?tree] + (case (:type ?tree) + ::adt* + (update-in ?tree [:patterns] + #(into {} (for [[?tag ?unapply] % + :let [=unapply (update-in ?unapply [:parts] (partial map (partial raise-tree-bindings outer-scope to-raise)))]] + [?tag =unapply]))) + + ::defaults + (update-in ?tree [:stores] + #(into {} (for [[?store ?branches] % + :let [=store (raise-bindings outer-scope to-raise {:form ?store :type ::&type/nothing})]] + [(:form =store) ?branches]))) + ;; else + (assert false (pr-str ?tree)) + )) + +(defn ^:private raise-bindings [outer-scope to-raise body] + ;; (prn 'raise-bindings body) + (match (:form body) + [::local ?scope ?idx] + {:form [::local outer-scope (inc ?idx)] + :type (:type body)} - [::&parser/form ([[::&parser/ident ?name] & ?args] :seq)] - (exec [def?? (defined? ?name)] - (if def?? - (fail (str "Can't redefine function/constant: " ?name)) - (exec [ann?? (annotated? ?name) - args (map-m extract-ident ?args) - [=function =args =return] (within ::types (&type/fresh-function (count args))) - :let [scoped-name (str "def_" ?name)] - current-module module-name - [=value] (with-env scoped-name - (with-local ?name (annotated [::global-fn current-module ?name] =function) - (with-lets (map vector args =args) - (analyse-ast ?value)))) - =function (within ::types (exec [_ (&type/solve =return (:type =value))] - (&type/clean =function))) - _ (if ann?? - (return nil) - (annotate ?name ::function ::public false =function)) - _ (define ?name)] - (return (list (annotated [::def [?name args] =value] ::&type/nothing)))))) + [::captured _ _ ?source] + (if (contains? to-raise body) + ?source + body) + + [::jvm:iadd ?x ?y] + {:form [::jvm:iadd + (raise-bindings outer-scope to-raise ?x) + (raise-bindings outer-scope to-raise ?y)] + :type (:type body)} + + [::case ?base ?variant ?registers ?mappings ?tree] + (let [=variant (raise-bindings outer-scope to-raise ?variant) + =mappings (into {} (for [[idx syntax] ?mappings] + [idx (raise-bindings outer-scope to-raise syntax)])) + =tree (raise-tree-bindings outer-scope to-raise ?tree)] + {:form [::case ?base =variant ?registers =mappings =tree] + :type (:type body)}) + + [::call ?func ?args] + {:form [::call (raise-bindings outer-scope to-raise ?func) + (map (partial raise-bindings outer-scope to-raise) ?args)] + :type (:type body)} )) +;; [:lux.util/ok [{:lux.lexer/source "", :lux.analyser/current-module "lux", :lux.analyser/modules {"lux" {"fold" {:mode :lux.analyser/constant, :access :lux.analyser/public, :macro? false, :type [:lux.type/function (:lux.type/var 6) :lux.type/any], :defined? true}, "+" {:mode :lux.analyser/constant, :access :lux.analyser/public, :macro? false, :type [:lux.type/function (:lux.type/var 2) :lux.type/any], :defined? true}, "id" {:mode :lux.analyser/constant, :access :lux.analyser/public, :macro? false, :type [:lux.type/function (:lux.type/var 0) :lux.type/any], :defined? true}}}, :lux.analyser/global-env {"fold" {:form [:lux.analyser/global "lux" "fold"], :type [:lux.type/function (:lux.type/var 6) :lux.type/any]}, "lux:fold" {:form [:lux.analyser/global "lux" "fold"], :type [:lux.type/function (:lux.type/var 6) :lux.type/any]}, "+" {:form [:lux.analyser/global "lux" "+"], :type [:lux.type/function (:lux.type/var 2) :lux.type/any]}, "lux:+" {:form [:lux.analyser/global "lux" "+"], :type [:lux.type/function (:lux.type/var 2) :lux.type/any]}, "id" {:form [:lux.analyser/global "lux" "id"], :type [:lux.type/function (:lux.type/var 0) :lux.type/any]}, "lux:id" {:form [:lux.analyser/global "lux" "id"], :type [:lux.type/function (:lux.type/var 0) :lux.type/any]}}, :lux.analyser/local-envs (), :lux.analyser/types {:lux.type/counter 12, :lux.type/mappings {0 [:lux.type/any :lux.type/nothing], 7 [:lux.type/any [:lux.type/function (:lux.type/var 8) :lux.type/any]], 1 [:lux.type/any :lux.type/any], 4 [:lux.type/any :lux.type/nothing], 6 [:lux.type/any :lux.type/nothing], 3 [:lux.type/any [:lux.type/function (:lux.type/var 4) :lux.type/any]], 2 [:lux.type/any :lux.type/nothing], 11 [:lux.type/any :lux.type/nothing], 9 [:lux.type/any [:lux.type/function (:lux.type/var 10) :lux.type/any]], 5 [:lux.type/any [:lux.type/object "java.lang.Integer" []]], 10 [:lux.type/any :lux.type/nothing], 8 [:lux.type/any :lux.type/nothing]}}} +;; ({:form [:lux.analyser/definterface ["lux" "Function"] {:methods {"apply" {:access :lux.analyser/public, :type [("java.lang.Object") "java.lang.Object"]}}}], :type :lux.type/nothing} {:form [:lux.analyser/defclass ["lux" "Tuple0"] "java.lang.Object" {:fields {}}], :type :lux.type/nothing} {:form [:lux.analyser/defclass ["lux" "Tuple1"] "java.lang.Object" {:fields {"_1" {:access :lux.analyser/public, :type "java.lang.Object"}}}], :type :lux.type/nothing} {:form [:lux.analyser/defclass ["lux" "Tuple2"] "java.lang.Object" {:fields {"_1" {:access :lux.analyser/public, :type "java.lang.Object"}, "_2" {:access :lux.analyser/public, :type "java.lang.Object"}}}], :type :lux.type/nothing} {:form [:lux.analyser/defclass ["lux" "Tuple3"] "java.lang.Object" {:fields {"_1" {:access :lux.analyser/public, :type "java.lang.Object"}, "_2" {:access :lux.analyser/public, :type "java.lang.Object"}, "_3" {:access :lux.analyser/public, :type "java.lang.Object"}}}], :type :lux.type/nothing} {:form [:lux.analyser/defclass ["lux" "Tuple4"] "java.lang.Object" {:fields {"_1" {:access :lux.analyser/public, :type "java.lang.Object"}, "_2" {:access :lux.analyser/public, :type "java.lang.Object"}, "_3" {:access :lux.analyser/public, :type "java.lang.Object"}, "_4" {:access :lux.analyser/public, :type "java.lang.Object"}}}], :type :lux.type/nothing} {:form [:lux.analyser/defclass ["lux" "Tuple5"] "java.lang.Object" {:fields {"_1" {:access :lux.analyser/public, :type "java.lang.Object"}, "_2" {:access :lux.analyser/public, :type "java.lang.Object"}, "_3" {:access :lux.analyser/public, :type "java.lang.Object"}, "_4" {:access :lux.analyser/public, :type "java.lang.Object"}, "_5" {:access :lux.analyser/public, :type "java.lang.Object"}}}], :type :lux.type/nothing} {:form [:lux.analyser/defclass ["lux" "Tuple6"] "java.lang.Object" {:fields {"_1" {:access :lux.analyser/public, :type "java.lang.Object"}, "_2" {:access :lux.analyser/public, :type "java.lang.Object"}, "_3" {:access :lux.analyser/public, :type "java.lang.Object"}, "_4" {:access :lux.analyser/public, :type "java.lang.Object"}, "_5" {:access :lux.analyser/public, :type "java.lang.Object"}, "_6" {:access :lux.analyser/public, :type "java.lang.Object"}}}], :type :lux.type/nothing} {:form [:lux.analyser/defclass ["lux" "Tuple7"] "java.lang.Object" {:fields {"_1" {:access :lux.analyser/public, :type "java.lang.Object"}, "_2" {:access :lux.analyser/public, :type "java.lang.Object"}, "_3" {:access :lux.analyser/public, :type "java.lang.Object"}, "_4" {:access :lux.analyser/public, :type "java.lang.Object"}, "_5" {:access :lux.analyser/public, :type "java.lang.Object"}, "_6" {:access :lux.analyser/public, :type "java.lang.Object"}, "_7" {:access :lux.analyser/public, :type "java.lang.Object"}}}], :type :lux.type/nothing} {:form [:lux.analyser/defclass ["lux" "Tuple8"] "java.lang.Object" {:fields {"_1" {:access :lux.analyser/public, :type "java.lang.Object"}, "_2" {:access :lux.analyser/public, :type "java.lang.Object"}, "_3" {:access :lux.analyser/public, :type "java.lang.Object"}, "_4" {:access :lux.analyser/public, :type "java.lang.Object"}, "_5" {:access :lux.analyser/public, :type "java.lang.Object"}, "_6" {:access :lux.analyser/public, :type "java.lang.Object"}, "_7" {:access :lux.analyser/public, :type "java.lang.Object"}, "_8" {:access :lux.analyser/public, :type "java.lang.Object"}}}], :type :lux.type/nothing} {:form [:lux.analyser/defclass ["lux" "Variant"] "java.lang.Object" {:fields {"tag" {:access :lux.analyser/public, :type "java.lang.String"}}}], :type :lux.type/nothing} {:form [:lux.analyser/defclass ["lux" "Variant0"] "lux.Variant" {:fields {}}], :type :lux.type/nothing} {:form [:lux.analyser/defclass ["lux" "Variant1"] "lux.Variant" {:fields {"_1" {:access :lux.analyser/public, :type "java.lang.Object"}}}], :type :lux.type/nothing} {:form [:lux.analyser/defclass ["lux" "Variant2"] "lux.Variant" {:fields {"_1" {:access :lux.analyser/public, :type "java.lang.Object"}, "_2" {:access :lux.analyser/public, :type "java.lang.Object"}}}], :type :lux.type/nothing} {:form [:lux.analyser/defclass ["lux" "Variant3"] "lux.Variant" {:fields {"_1" {:access :lux.analyser/public, :type "java.lang.Object"}, "_2" {:access :lux.analyser/public, :type "java.lang.Object"}, "_3" {:access :lux.analyser/public, :type "java.lang.Object"}}}], :type :lux.type/nothing} {:form [:lux.analyser/defclass ["lux" "Variant4"] "lux.Variant" {:fields {"_1" {:access :lux.analyser/public, :type "java.lang.Object"}, "_2" {:access :lux.analyser/public, :type "java.lang.Object"}, "_3" {:access :lux.analyser/public, :type "java.lang.Object"}, "_4" {:access :lux.analyser/public, :type "java.lang.Object"}}}], :type :lux.type/nothing} {:form [:lux.analyser/defclass ["lux" "Variant5"] "lux.Variant" {:fields {"_1" {:access :lux.analyser/public, :type "java.lang.Object"}, "_2" {:access :lux.analyser/public, :type "java.lang.Object"}, "_3" {:access :lux.analyser/public, :type "java.lang.Object"}, "_4" {:access :lux.analyser/public, :type "java.lang.Object"}, "_5" {:access :lux.analyser/public, :type "java.lang.Object"}}}], :type :lux.type/nothing} {:form [:lux.analyser/defclass ["lux" "Variant6"] "lux.Variant" {:fields {"_1" {:access :lux.analyser/public, :type "java.lang.Object"}, "_2" {:access :lux.analyser/public, :type "java.lang.Object"}, "_3" {:access :lux.analyser/public, :type "java.lang.Object"}, "_4" {:access :lux.analyser/public, :type "java.lang.Object"}, "_5" {:access :lux.analyser/public, :type "java.lang.Object"}, "_6" {:access :lux.analyser/public, :type "java.lang.Object"}}}], :type :lux.type/nothing} {:form [:lux.analyser/defclass ["lux" "Variant7"] "lux.Variant" {:fields {"_1" {:access :lux.analyser/public, :type "java.lang.Object"}, "_2" {:access :lux.analyser/public, :type "java.lang.Object"}, "_3" {:access :lux.analyser/public, :type "java.lang.Object"}, "_4" {:access :lux.analyser/public, :type "java.lang.Object"}, "_5" {:access :lux.analyser/public, :type "java.lang.Object"}, "_6" {:access :lux.analyser/public, :type "java.lang.Object"}, "_7" {:access :lux.analyser/public, :type "java.lang.Object"}}}], :type :lux.type/nothing} {:form [:lux.analyser/defclass ["lux" "Variant8"] "lux.Variant" {:fields {"_1" {:access :lux.analyser/public, :type "java.lang.Object"}, "_2" {:access :lux.analyser/public, :type "java.lang.Object"}, "_3" {:access :lux.analyser/public, :type "java.lang.Object"}, "_4" {:access :lux.analyser/public, :type "java.lang.Object"}, "_5" {:access :lux.analyser/public, :type "java.lang.Object"}, "_6" {:access :lux.analyser/public, :type "java.lang.Object"}, "_7" {:access :lux.analyser/public, :type "java.lang.Object"}, "_8" {:access :lux.analyser/public, :type "java.lang.Object"}}}], :type :lux.type/nothing} +;; )]] + +;; {:form [:lux.analyser/def "id" {:form [:lux.analyser/lambda "def_id$0" {} ("x") {:form [:lux.analyser/local "def_id$0" 0], :type [:lux.type/var 0]}], +;; :type [:lux.type/function (:lux.type/var 0) :lux.type/any]}], +;; :type :lux.type/nothing} + +;; {:form [:lux.analyser/def "+" {:form [:lux.analyser/lambda "def_+$0" {} ("x" "y") +;; {:form [:lux.analyser/jvm:iadd +;; {:form [:lux.analyser/local "def_+$0" 0], :type [:lux.type/var 2]} +;; {:form [:lux.analyser/local "def_+$0" 1], :type [:lux.type/var 4]}], +;; :type [:lux.type/object "java.lang.Integer" []]}], +;; :type [:lux.type/function (:lux.type/var 2) :lux.type/any]}], +;; :type :lux.type/nothing} + +;; {:form [:lux.analyser/def "fold" {:form [:lux.analyser/lambda "def_fold$0" {} ("f" "init" "values") +;; {:form [:lux.analyser/case 0 {:form [:lux.analyser/local "def_fold$0" 2], :type [:lux.type/var 10]} +;; 2 {1 {:form [:lux.analyser/call {:form [:lux.analyser/captured "def_fold$0$0" 0 {:form [:lux.analyser/self "def_fold$0" []], :type [:lux.type/function [:lux.type/var 6] [:lux.type/var 7]]}], :type [:lux.type/function [:lux.type/var 6] [:lux.type/var 7]]} +;; ({:form [:lux.analyser/local "def_fold$0" 0], :type [:lux.type/var 6]} +;; {:form [:lux.analyser/call {:form [:lux.analyser/local "def_fold$0" 0], :type [:lux.type/var 6]} ({:form [:lux.analyser/local "def_fold$0" 1], :type [:lux.type/var 8]} {:form [:lux.analyser/local "def_fold$0" 3], :type [:lux.type/object "java.lang.Object" []]})], :type [:lux.type/object "java.lang.Object" []]} +;; {:form [:lux.analyser/local "def_fold$0" 4], :type [:lux.type/object "java.lang.Object" []]})], +;; :type [:lux.type/object "java.lang.Object" []]}, +;; 0 {:form [:lux.analyser/local "def_fold$0" 1], :type [:lux.type/var 8]}} +;; {:type :lux.analyser/adt*, +;; :patterns {"Cons" {:parts ({:type :lux.analyser/defaults, :stores {[:lux.analyser/local "def_fold$0" 3] #{1}}, :branches #{1}} +;; {:type :lux.analyser/defaults, :stores {[:lux.analyser/local "def_fold$0" 4] #{1}}, :branches #{1}}), +;; :branches #{1}}, +;; "Nil" {:parts (), :branches #{0}}}, +;; :default nil, +;; :branches #{0 1}}], +;; :type :lux.type/nothing}], +;; :type [:lux.type/function (:lux.type/var 6) :lux.type/any]}], +;; :type :lux.type/nothing} + +(defn ^:private analyse-lambda [analyse-ast ?self ?arg ?body] + (exec [[_ =arg =return :as =function] (within ::types &type/fresh-function) + [=scope =next-local =captured =body] (with-lambda ?self =function + ?arg =arg + (analyse-ast ?body)) + _ (&util/assert! (= 1 (count =body)) "Can't return more than 1 value.") + :let [[=body] =body] + :let [_ (prn 'analyse-lambda/=body ?arg =captured =body)] + =function (within ::types (exec [_ (&type/solve =return (:type =body))] + (&type/clean =function))) + :let [_ (prn '(:form =body) (:form =body)) + =lambda (match (:form =body) + [::lambda ?sub-scope ?sub-captured ?sub-args ?sub-body] + (let [?sub-body* (raise-bindings =scope (set (map #(get ?sub-captured %) (cons ?arg (keys =captured)))) + ?sub-body)] + [::lambda =scope =captured (cons ?arg ?sub-args) ?sub-body*]) + + _ + [::lambda =scope =captured (list ?arg) =body])]] + (return (list (annotated =lambda =function))))) + +(defn ^:private analyse-def [analyse-ast ?name ?value] + (exec [def?? (defined? ?name)] + (if def?? + (fail (str "Can't redefine function/constant: " ?name)) + (exec [ann?? (annotated? ?name) + :let [scoped-name (str "def_" ?name)] + [=value] (with-env scoped-name + (analyse-ast ?value)) + _ (if ann?? + (return nil) + (annotate ?name ::constant ::public false (:type =value))) + _ (define ?name)] + (return (list (annotated [::def ?name =value] ::&type/nothing))))))) + (defn ^:private analyse-annotate [?ident] (exec [_ (annotate ?ident ::function ::public true ::&type/nothing)] (return (list)))) @@ -786,11 +877,11 @@ [::&parser/form ([[::&parser/ident "case"] ?variant & ?branches] :seq)] (analyse-case analyse-ast ?variant ?branches) - [::&parser/form ([[::&parser/ident "lambda"] [::&parser/tuple ?args] ?body] :seq)] - (analyse-lambda analyse-ast ?args ?body) + [::&parser/form ([[::&parser/ident "lambda'"] [::&parser/ident ?self] [::&parser/ident ?arg] ?body] :seq)] + (analyse-lambda analyse-ast ?self ?arg ?body) - [::&parser/form ([[::&parser/ident "def"] ?usage ?value] :seq)] - (analyse-def analyse-ast ?usage ?value) + [::&parser/form ([[::&parser/ident "def'"] [::&parser/ident ?name] ?value] :seq)] + (analyse-def analyse-ast ?name ?value) [::&parser/form ([[::&parser/ident "annotate"] [::&parser/ident ?ident] [::&parser/ident "Macro"]] :seq)] (analyse-annotate ?ident) @@ -879,4 +970,37 @@ ::local-envs (list) ::types &type/+init+}))) ) + + (do (defn raise-bindings [outer-scope to-raise body] + (match (:form body) + [::local ?scope ?idx] + {:form [::local outer-scope (inc ?idx)] + :type (:type body)} + + [::captured _ _ ?source] + (if (contains? to-raise body) + ?source + body) + + [::jvm:iadd ?x ?y] + (let [=x (raise-bindings outer-scope to-raise ?x) + =y (raise-bindings outer-scope to-raise ?y)] + {:form [:lux.analyser/jvm:iadd =x =y] + :type (:type body)}))) + (let [?scope "def_+$0" + ?captured {} + ?arg "x" + =body '{:form [:lux.analyser/lambda "def_+$0$0" {"x" {:form [:lux.analyser/captured "def_+$0$0" 0 {:form [:lux.analyser/local "def_+$0" 0], :type [:lux.type/var 2]}], :type [:lux.type/var 2]}} + ("y") + {:form [:lux.analyser/jvm:iadd + {:form [:lux.analyser/captured "def_+$0$0" 0 {:form [:lux.analyser/local "def_+$0" 0], :type [:lux.type/var 2]}], :type [:lux.type/var 2]} + {:form [:lux.analyser/local "def_+$0$0" 0], :type [:lux.type/var 4]}], + :type [:lux.type/object "java.lang.Integer" []]}], + :type [:lux.type/function (:lux.type/var 4) :lux.type/any]}] + (match (:form =body) + [::lambda ?sub-scope ?sub-captured ?sub-args ?sub-body] + (let [?sub-body* (raise-bindings ?scope (set (map #(get ?sub-captured %) (cons ?arg (keys ?captured)))) + ?sub-body)] + [::lambda ?scope ?captured (cons ?arg ?sub-args) ?sub-body*]))) + ) ) diff --git a/src/lux/type.clj b/src/lux/type.clj index 854610de7..ae0b882e5 100644 --- a/src/lux/type.clj +++ b/src/lux/type.clj @@ -32,11 +32,10 @@ (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]))) +(def fresh-function + (exec [=arg fresh-var + =return fresh-var] + (return [::function =arg =return]))) (defn solve [expected actual] ;; (prn 'solve expected actual) |