diff options
Diffstat (limited to '')
| -rw-r--r-- | source/lux.lux | 310 | ||||
| -rw-r--r-- | src/lux.clj | 4 | ||||
| -rw-r--r-- | src/lux/analyser.clj | 250 | ||||
| -rw-r--r-- | src/lux/analyser/base.clj | 14 | ||||
| -rw-r--r-- | src/lux/analyser/case.clj | 6 | ||||
| -rw-r--r-- | src/lux/analyser/host.clj | 152 | ||||
| -rw-r--r-- | src/lux/analyser/lux.clj | 134 | ||||
| -rw-r--r-- | src/lux/base.clj | 85 | ||||
| -rw-r--r-- | src/lux/compiler.clj | 30 | ||||
| -rw-r--r-- | src/lux/compiler/host.clj | 20 | ||||
| -rw-r--r-- | src/lux/compiler/lambda.clj | 2 | ||||
| -rw-r--r-- | src/lux/host.clj | 22 | ||||
| -rw-r--r-- | src/lux/optimizer.clj | 3 | ||||
| -rw-r--r-- | src/lux/parser.clj | 30 | ||||
| -rw-r--r-- | src/lux/type.clj | 479 |
15 files changed, 842 insertions, 699 deletions
diff --git a/source/lux.lux b/source/lux.lux index 994fcd8cd..18e488897 100644 --- a/source/lux.lux +++ b/source/lux.lux @@ -171,8 +171,8 @@ #Nil #Nil - (#Cons [x xs*]) - (#Cons [(f x) (map f xs*)]))) + (#Cons [x xs']) + (#Cons [(f x) (map f xs')]))) (def flat-map (. concat map)) @@ -658,65 +658,6 @@ ys (map% f xs')] (return (#Cons [y ys]))))) -(defmacro (type tokens) - (case' tokens - (#Tuple elems) - (return (list (` (#Tuple (~ (map untemplate elems)))))) - - (#Record fields) - (return (list (` (#Record (~ (map (lambda [kv] - (case' kv - [(#Tag tag) val] - [tag (untemplate val)])) - fields)))))) - - (#Form (#Cons [(#Ident "|") options])) - (do [options' (map% (lambda [opt] - (case' opt - (#Tag tag) - (return [tag (#Tuple (list))]) - - (#Form (#Cons [(#Tag tag) (#Cons [value #Nil])])) - (return [tag value]) - - _ - (fail ""))) - options)] - (return (list (#Variant options')))))) - -(defmacro (All tokens) - (let [[name args body] (case' tokens - (#Cons [(#Tuple args) (#Cons [body #Nil])]) - [(#Text "") args body] - - (#Cons [(#Ident name) (#Cons [(#Tuple args) (#Cons [body #Nil])])]) - [(#Text name) args body])] - (return (list (#Form (list (#Tag "All") - name - (#Tuple (map (lambda [arg] - (case' arg - (#Ident arg') - (#Text arg'))) - args)) - body)))))) - -(defmacro (Exists tokens) - (case' tokens - (#Cons [(#Ident name) (#Cons [body #Nil])]) - (return (list (` (#Exists (~ name) (~ body))))))) - -(defmacro (deftype tokens) - (case' tokens - (#Cons [(#Form (#Cons [name args])) (#Cons [definition #Nil])]) - (return (list (` (def (~ name) - (All (~ name) [(~@ args)] - (type (~ definition))))))) - - (#Cons [name (#Cons [definition #Nil])]) - (return (list (` (def (~ name) - (type (~ definition)))))) - )) - (defmacro ($keys tokens) (case' tokens (#Cons [(#Tuple fields) #Nil]) @@ -732,6 +673,35 @@ (return (flat-map (lambda [pattern] (list pattern body)) patterns)))) +(def null jvm-null) + +(defmacro (^ tokens) + (case' tokens + (#Cons [(#Ident class-name) #Nil]) + (return (list (` (#Data (~ (#Text class-name)))))))) + +(defmacro (, members) + (return (list (#Form (list+ (#Tag "Tuple") (untemplate-list members)))))) + +(defmacro (| members) + (let [members' (map (lambda [m] + (case' m + (#Tag tag) + [tag (` (#Tuple (list)))] + + (#Form (#Cons [tag (#Cons [value #Nil])])) + [tag (` (#Tuple (~ value)))])) + members)] + (return (list (#Form (list+ (#Tag "Variant") (untemplate-list members))))))) + +(defmacro (& members) + (let [members' (map (lambda [m] + (case' m + (#Form (#Cons [tag (#Cons [value #Nil])])) + [tag (` (#Tuple (~ value)))])) + members)] + (return (list (#Form (list+ (#Tag "Record") (untemplate-list members))))))) + (defmacro (-> tokens) (case' (reverse tokens) (#Cons [f-return f-args]) @@ -739,47 +709,169 @@ (#Lambda [f-arg f-return])) f-return f-args))) -(def null jvm-null) +(def (replace-ident ident value syntax) + (case' syntax + (#Ident test) + (if (= test ident) + value + syntax) -## (defmacro (case tokens) -## (case' tokens -## (#Cons value branches) -## (loop [kind #Pattern -## pieces branches -## new-pieces (list)] -## (case' pieces -## #Nil -## (return (list (' (case' (~ value) (~@ new-pieces))))) - -## (#Cons piece pieces') -## (let [[kind' expanded more-pieces] (case' kind -## #Body -## [#Pattern (list piece) #Nil] - -## #Pattern -## (do [expansion (macro-expand piece)] -## (case' expansion -## #Nil -## [#Pattern #Nil #Nil] - -## (#Cons exp #Nil) -## [#Body (list exp) #Nil] - -## (#Cons exp exps) -## [#Body (list exp) exps])) -## )] -## (recur kind' (++ expanded new-pieces) (++ more-pieces pieces)))) -## ))) - - -## (def (defsyntax tokens) -## ...) + (#Form members) + (#Form (map (replace-ident ident value) members)) -## (def (defsig tokens) -## ...) + (#Tuple members) + (#Tuple (map (replace-ident ident value) members)) -## (def (defstruct tokens) -## ...) + (#Record members) + (#Record (map (lambda [kv] + (case kv + [k v] + [k (replace-ident ident value v)])) + members)) + + _ + syntax)) + +(defmacro (All tokens) + (let [[name args body] (case' tokens + (#Cons [(#Ident name) (#Cons [(#Tuple args) (#Cons [body #Nil])])]) + [name args body] + + (#Cons [(#Tuple args) (#Cons [body #Nil])]) + ["" args body]) + rolled (fold (lambda [body arg] + (case' arg + (#Ident arg-name) + (` (#All (list) (~ (#Text "")) (~ arg) (~ (replace-ident arg-name (` (#Bound (~ (#Text arg-name)))) + body)))))) + body args)] + (case' rolled + (#Form (#Cons [(#Tag "All") (#Cons [env (#Cons [(#Test "") (#Cons [arg (#Cons [body #Nil])])])])])) + (return (list (` (#All (~ env) (~ (#Text name)) (~ arg) + (~ (replace-ident arg-name (` (#Bound (~ (#Text name)))) + body))))))))) + +(defmacro (Exists tokens) + (case' tokens + (#Cons [args (#Cons [body #Nil])]) + (return (list (` (All (~ args) (~ body))))))) + +(def Any (| #Any)) +(def Nothing (| #Nothing)) +(def Text (^ java.lang.String)) +(def Int (^ java.lang.Long)) + +(deftype (List a) + (| #Nil + (#Cons (, a (List a))))) + +(deftype #rec Type + (| #Any + #Nothing + (#Data Text) + (#Tuple (List Type)) + (#Variant (List (, Text Type))) + (#Record (List (, Text Type))) + (#Lambda (, Type Type)) + (#Bound Text) + (#Var Int) + (#All (, (List (, Text Type)) Text Text Type)) + (#App (, Type Type)))) + +(deftype (Either l r) + (| (#Left l) + (#Right r))) + +(deftype #rec Syntax + (| (#Bool Bool) + (#Int Int) + (#Real Real) + (#Char Char) + (#Text Text) + (#Form (List Syntax)) + (#Tuple (List Syntax)) + (#Record (List (, Text Syntax))))) + +(deftype Macro + (-> (List Syntax) CompilerState + (Either Text (, CompilerState (List Syntax))))) + +(def (macro-expand syntax) + (case' syntax + (#Form (#Cons [(#Ident macro-name) args])) + (do [macro (get-macro macro-name)] + ((coerce macro Macro) args)))) + +(defmacro (case tokens) + (case' tokens + (#Cons value branches) + (loop [kind #Pattern + pieces branches + new-pieces (list)] + (case' pieces + #Nil + (return (list (' (case' (~ value) (~@ new-pieces))))) + + (#Cons piece pieces') + (let [[kind' expanded more-pieces] (case' kind + #Body + [#Pattern (list piece) #Nil] + + #Pattern + (do [expansion (macro-expand piece)] + (case' expansion + #Nil + [#Pattern #Nil #Nil] + + (#Cons exp #Nil) + [#Body (list exp) #Nil] + + (#Cons exp exps) + [#Body (list exp) exps])) + )] + (recur kind' (++ expanded new-pieces) (++ more-pieces pieces)))) + ))) + +(def (defsyntax tokens) + ...) + +(deftype (State s a) + (-> s (, s a))) + +(deftype (Parser a) + (State (List Syntax) a)) + +(def (parse-ctor tokens) + (Parser (, Syntax (List Syntax))) + (case tokens + (list+ (#Ident name) tokens') + [tokens' [(#Ident name) (list)]] + + (list+ (#Form (list+ (#Ident name) args)) tokens') + [tokens' [(#Ident name) args]])) + +(defsyntax (defsig [[name args] parse-ctor] [anns ($+ $1)]) + (let [def-body (fold (lambda [body arg] (` (lambda [(~ arg)] (~ body)))) + (` (#Record (~ (untemplate-list ...)))) + args)] + (return (list (` (def (~ name) (~ def-body))))))) + +(defsyntax (defstruct [[name args] parse-ctor] sig [defs ($+ $1)]) + (let [def-body (fold (lambda [body arg] (` (lambda [(~ arg)] (~ body)))) + (` (#Record (~ (untemplate-list ...)))) + args)] + (return (list (` (def (~ name) + (: (~ def-body) (~ sig)))))))) + +(defsig (Monad m) + (: return (All [a] (-> a (m a)))) + (: bind (All [a b] (-> (-> a (m b)) (m a) (m b))))) + +(defstruct ListMonad (Monad List) + (def (return x) + (list x)) + + (def bind (. concat map))) ## (def (with tokens) ## ...) @@ -789,15 +881,6 @@ ## TODO: (Im|Ex)ports-related macros ## TODO: Macro-related macros -## (deftype (List a) -## (|| #Nil (#Cons [a (List a)]))) - -## (deftype User -## (&& (#name Text) (#age Int))) - -## (deftype User -## (** Text Int)) - ## (import "lux") ## (module-alias "lux" "l") ## (def-alias "lux;map" "map") @@ -807,14 +890,3 @@ ## ...)) ## (require lux #as l #refer [map]) - -## (type (| #Nil -## (#Cons [a (List a)]))) - -## (type [Int Bool Text]) - -## (type {#id Int #alive? Bool #name Text}) - -## (deftype (List a) -## (| #Nil -## (#Cons [a (List a)]))) diff --git a/src/lux.clj b/src/lux.clj index 508b45bb9..c7b000e5b 100644 --- a/src/lux.clj +++ b/src/lux.clj @@ -19,7 +19,3 @@ ;; 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 8c8bb61d1..123783daa 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -3,7 +3,8 @@ [clojure.core.match :as M :refer [match matchv]] clojure.core.match.array (lux [base :as & :refer [exec return fail - try-all-m map-m mapcat-m reduce-m + |list + try-all-m map-m |flat-map% reduce-m assert!]] [parser :as &parser] [type :as &type] @@ -28,202 +29,208 @@ ["Nil" _]]]]]]] [catch+ ?finally-body])) -(defn ^:private analyse-basic-ast [analyse-ast token] +(defn ^:private analyse-basic-ast [analyse eval! token] ;; (prn 'analyse-basic-ast token (&/show-ast token)) (matchv ::M/objects [token] ;; Standard special forms [["Bool" ?value]] - (return (list [::&&/Expression [::&&/bool ?value] [::&type/Data "java.lang.Boolean"]])) + (return (|list [::&&/Expression [::&&/bool ?value] (&/V "Data" (to-array ["java.lang.Boolean" (&/V "Nil" nil)]))])) [["Int" ?value]] - (return (list [::&&/Expression [::&&/int ?value] [::&type/Data "java.lang.Long"]])) + (return (|list [::&&/Expression [::&&/int ?value] (&/V "Data" (to-array ["java.lang.Long" (&/V "Nil" nil)]))])) [["Real" ?value]] - (return (list [::&&/Expression [::&&/real ?value] [::&type/Data "java.lang.Double"]])) + (return (|list [::&&/Expression [::&&/real ?value] (&/V "Data" (to-array ["java.lang.Double" (&/V "Nil" nil)]))])) [["Char" ?value]] - (return (list [::&&/Expression [::&&/char ?value] [::&type/Data "java.lang.Character"]])) + (return (|list [::&&/Expression [::&&/char ?value] (&/V "Data" (to-array ["java.lang.Character" (&/V "Nil" nil)]))])) [["Text" ?value]] - (return (list [::&&/Expression [::&&/text ?value] [::&type/Data "java.lang.String"]])) + (return (|list [::&&/Expression [::&&/text ?value] (&/V "Data" (to-array ["java.lang.String" (&/V "Nil" nil)]))])) [["Tuple" ?elems]] - (&&lux/analyse-tuple analyse-ast (&/->seq ?elems)) + (&&lux/analyse-tuple analyse ?elems) [["Record" ?elems]] - (&&lux/analyse-record analyse-ast (&/->seq ?elems)) + (&&lux/analyse-record analyse ?elems) [["Tag" ?tag]] - (let [tuple-type [::&type/Tuple (list)]] - (return (list [::&&/Expression [::&&/variant ?tag [::&&/Expression [::&&/tuple (list)] tuple-type]] - [::&type/Variant (list [?tag tuple-type])]]))) + (let [tuple-type (&/V "Tuple" (&/V "Nil" nil))] + (return (|list [::&&/Expression [::&&/variant ?tag [::&&/Expression [::&&/tuple (list)] tuple-type]] + (&/V "Variant" (&/V "Cons" (to-array [(to-array [?tag tuple-type]) (&/V "Nil" nil)])))]))) [["Ident" "jvm-null"]] - (return (list [::&&/Expression [::&&/jvm-null] [::&type/Data "null"]])) + (return (|list [::&&/Expression [::&&/jvm-null] (&/V "Data" (to-array ["null" (&/V "Nil" nil)]))])) [["Ident" ?ident]] - (&&lux/analyse-ident analyse-ast ?ident) + (&&lux/analyse-ident analyse ?ident) [["Form" ["Cons" [["Ident" "case'"] ["Cons" [?variant ?branches]]]]]] - (&&lux/analyse-case analyse-ast ?variant (&/->seq ?branches)) + (&&lux/analyse-case analyse ?variant (&/->seq ?branches)) [["Form" ["Cons" [["Ident" "lambda'"] ["Cons" [["Ident" ?self] ["Cons" [["Ident" ?arg] ["Cons" [?body ["Nil" _]]]]]]]]]]] - (&&lux/analyse-lambda analyse-ast ?self ?arg ?body) + (&&lux/analyse-lambda analyse ?self ?arg ?body) [["Form" ["Cons" [["Ident" "get@'"] ["Cons" [["Tag" ?slot] ["Cons" [?record ["Nil" _]]]]]]]]] - (&&lux/analyse-get analyse-ast ?slot ?record) + (&&lux/analyse-get analyse ?slot ?record) [["Form" ["Cons" [["Ident" "set@'"] ["Cons" [["Tag" ?slot] ["Cons" [?value ["Cons" [?record ["Nil" _]]]]]]]]]]] - (&&lux/analyse-set analyse-ast ?slot ?value ?record) + (&&lux/analyse-set analyse ?slot ?value ?record) [["Form" ["Cons" [["Ident" "def'"] ["Cons" [["Ident" ?name] ["Cons" [?value ["Nil" _]]]]]]]]] - (&&lux/analyse-def analyse-ast ?name ?value) + (&&lux/analyse-def analyse ?name ?value) [["Form" ["Cons" [["Ident" "declare-macro"] ["Cons" [["Ident" ?ident] ["Nil" _]]]]]]] (&&lux/analyse-declare-macro ?ident) [["Form" ["Cons" [["Ident" "import'"] ["Cons" [["Text" ?path] ["Nil" _]]]]]]] - (&&lux/analyse-import analyse-ast ?path) + (&&lux/analyse-import analyse ?path) + + [["Form" ["Cons" [["Ident" ":"] ["Cons" [?value ["Cons" [?type ["Nil" _]]]]]]]]] + (&&lux/analyse-check analyse eval! ?type ?value) + + [["Form" ["Cons" [["Ident" "coerce"] ["Cons" [?type ["Cons" [?value ["Nil" _]]]]]]]]] + (&&lux/analyse-coerce analyse eval! ?type ?value) ;; Host special forms [["Form" ["Cons" [["Ident" "exec"] ?exprs]]]] - (&&host/analyse-exec analyse-ast (&/->seq ?exprs)) + (&&host/analyse-exec analyse (&/->seq ?exprs)) ;; Integer arithmetic [["Form" ["Cons" [["Ident" "jvm-iadd"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] - (&&host/analyse-jvm-iadd analyse-ast ?x ?y) + (&&host/analyse-jvm-iadd analyse ?x ?y) [["Form" ["Cons" [["Ident" "jvm-isub"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] - (&&host/analyse-jvm-isub analyse-ast ?x ?y) + (&&host/analyse-jvm-isub analyse ?x ?y) [["Form" ["Cons" [["Ident" "jvm-imul"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] - (&&host/analyse-jvm-imul analyse-ast ?x ?y) + (&&host/analyse-jvm-imul analyse ?x ?y) [["Form" ["Cons" [["Ident" "jvm-idiv"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] - (&&host/analyse-jvm-idiv analyse-ast ?x ?y) + (&&host/analyse-jvm-idiv analyse ?x ?y) [["Form" ["Cons" [["Ident" "jvm-irem"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] - (&&host/analyse-jvm-irem analyse-ast ?x ?y) + (&&host/analyse-jvm-irem analyse ?x ?y) [["Form" ["Cons" [["Ident" "jvm-ieq"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] - (&&host/analyse-jvm-ieq analyse-ast ?x ?y) + (&&host/analyse-jvm-ieq analyse ?x ?y) [["Form" ["Cons" [["Ident" "jvm-ilt"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] - (&&host/analyse-jvm-ilt analyse-ast ?x ?y) + (&&host/analyse-jvm-ilt analyse ?x ?y) [["Form" ["Cons" [["Ident" "jvm-igt"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] - (&&host/analyse-jvm-igt analyse-ast ?x ?y) + (&&host/analyse-jvm-igt analyse ?x ?y) ;; Long arithmetic [["Form" ["Cons" [["Ident" "jvm-ladd"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] - (&&host/analyse-jvm-ladd analyse-ast ?x ?y) + (&&host/analyse-jvm-ladd analyse ?x ?y) [["Form" ["Cons" [["Ident" "jvm-lsub"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] - (&&host/analyse-jvm-lsub analyse-ast ?x ?y) + (&&host/analyse-jvm-lsub analyse ?x ?y) [["Form" ["Cons" [["Ident" "jvm-lmul"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] - (&&host/analyse-jvm-lmul analyse-ast ?x ?y) + (&&host/analyse-jvm-lmul analyse ?x ?y) [["Form" ["Cons" [["Ident" "jvm-ldiv"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] - (&&host/analyse-jvm-ldiv analyse-ast ?x ?y) + (&&host/analyse-jvm-ldiv analyse ?x ?y) [["Form" ["Cons" [["Ident" "jvm-lrem"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] - (&&host/analyse-jvm-lrem analyse-ast ?x ?y) + (&&host/analyse-jvm-lrem analyse ?x ?y) [["Form" ["Cons" [["Ident" "jvm-leq"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] - (&&host/analyse-jvm-leq analyse-ast ?x ?y) + (&&host/analyse-jvm-leq analyse ?x ?y) [["Form" ["Cons" [["Ident" "jvm-llt"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] - (&&host/analyse-jvm-llt analyse-ast ?x ?y) + (&&host/analyse-jvm-llt analyse ?x ?y) [["Form" ["Cons" [["Ident" "jvm-lgt"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] - (&&host/analyse-jvm-lgt analyse-ast ?x ?y) + (&&host/analyse-jvm-lgt analyse ?x ?y) ;; Float arithmetic [["Form" ["Cons" [["Ident" "jvm-fadd"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] - (&&host/analyse-jvm-fadd analyse-ast ?x ?y) + (&&host/analyse-jvm-fadd analyse ?x ?y) [["Form" ["Cons" [["Ident" "jvm-fsub"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] - (&&host/analyse-jvm-fsub analyse-ast ?x ?y) + (&&host/analyse-jvm-fsub analyse ?x ?y) [["Form" ["Cons" [["Ident" "jvm-fmul"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] - (&&host/analyse-jvm-fmul analyse-ast ?x ?y) + (&&host/analyse-jvm-fmul analyse ?x ?y) [["Form" ["Cons" [["Ident" "jvm-fdiv"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] - (&&host/analyse-jvm-fdiv analyse-ast ?x ?y) + (&&host/analyse-jvm-fdiv analyse ?x ?y) [["Form" ["Cons" [["Ident" "jvm-frem"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] - (&&host/analyse-jvm-frem analyse-ast ?x ?y) + (&&host/analyse-jvm-frem analyse ?x ?y) [["Form" ["Cons" [["Ident" "jvm-feq"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] - (&&host/analyse-jvm-feq analyse-ast ?x ?y) + (&&host/analyse-jvm-feq analyse ?x ?y) [["Form" ["Cons" [["Ident" "jvm-flt"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] - (&&host/analyse-jvm-flt analyse-ast ?x ?y) + (&&host/analyse-jvm-flt analyse ?x ?y) [["Form" ["Cons" [["Ident" "jvm-fgt"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] - (&&host/analyse-jvm-fgt analyse-ast ?x ?y) + (&&host/analyse-jvm-fgt analyse ?x ?y) ;; Double arithmetic [["Form" ["Cons" [["Ident" "jvm-dadd"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] - (&&host/analyse-jvm-dadd analyse-ast ?x ?y) + (&&host/analyse-jvm-dadd analyse ?x ?y) [["Form" ["Cons" [["Ident" "jvm-dsub"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] - (&&host/analyse-jvm-dsub analyse-ast ?x ?y) + (&&host/analyse-jvm-dsub analyse ?x ?y) [["Form" ["Cons" [["Ident" "jvm-dmul"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] - (&&host/analyse-jvm-dmul analyse-ast ?x ?y) + (&&host/analyse-jvm-dmul analyse ?x ?y) [["Form" ["Cons" [["Ident" "jvm-ddiv"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] - (&&host/analyse-jvm-ddiv analyse-ast ?x ?y) + (&&host/analyse-jvm-ddiv analyse ?x ?y) [["Form" ["Cons" [["Ident" "jvm-drem"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] - (&&host/analyse-jvm-drem analyse-ast ?x ?y) + (&&host/analyse-jvm-drem analyse ?x ?y) [["Form" ["Cons" [["Ident" "jvm-deq"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] - (&&host/analyse-jvm-deq analyse-ast ?x ?y) + (&&host/analyse-jvm-deq analyse ?x ?y) [["Form" ["Cons" [["Ident" "jvm-dlt"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] - (&&host/analyse-jvm-dlt analyse-ast ?x ?y) + (&&host/analyse-jvm-dlt analyse ?x ?y) [["Form" ["Cons" [["Ident" "jvm-dgt"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] - (&&host/analyse-jvm-dgt analyse-ast ?x ?y) + (&&host/analyse-jvm-dgt analyse ?x ?y) ;; Objects [["Form" ["Cons" [["Ident" "jvm-null?"] ["Cons" [?object ["Nil" _]]]]]]] - (&&host/analyse-jvm-null? analyse-ast ?object) + (&&host/analyse-jvm-null? analyse ?object) [["Form" ["Cons" [["Ident" "jvm-new"] ["Cons" [["Ident" ?class] ["Cons" [["Tuple" ?classes] ["Cons" [["Tuple" ?args] ["Nil" _]]]]]]]]]]] - (&&host/analyse-jvm-new analyse-ast ?class ?classes ?args) + (&&host/analyse-jvm-new analyse ?class ?classes ?args) [["Form" ["Cons" [["Ident" "jvm-getstatic"] ["Cons" [["Ident" ?class] ["Cons" [["Text" ?field] ["Nil" _]]]]]]]]] - (&&host/analyse-jvm-getstatic analyse-ast ?class ?field) + (&&host/analyse-jvm-getstatic analyse ?class ?field) [["Form" ["Cons" [["Ident" "jvm-getfield"] ["Cons" [["Ident" ?class] ["Cons" [["Text" ?field] ["Cons" [?object ["Nil" _]]]]]]]]]]] - (&&host/analyse-jvm-getfield analyse-ast ?class ?field ?object) + (&&host/analyse-jvm-getfield analyse ?class ?field ?object) [["Form" ["Cons" [["Ident" "jvm-putstatic"] ["Cons" [["Ident" ?class] ["Cons" [["Text" ?field] ["Cons" [?value ["Nil" _]]]]]]]]]]] - (&&host/analyse-jvm-putstatic analyse-ast ?class ?field ?value) + (&&host/analyse-jvm-putstatic analyse ?class ?field ?value) [["Form" ["Cons" [["Ident" "jvm-putfield"] ["Cons" [["Ident" ?class] @@ -231,7 +238,7 @@ ["Cons" [?object ["Cons" [?value ["Nil" _]]]]]]]]]]]]] - (&&host/analyse-jvm-putfield analyse-ast ?class ?field ?object ?value) + (&&host/analyse-jvm-putfield analyse ?class ?field ?object ?value) [["Form" ["Cons" [["Ident" "jvm-invokestatic"] ["Cons" [["Ident" ?class] @@ -239,7 +246,7 @@ ["Cons" [["Tuple" ?classes] ["Cons" [["Tuple" ?args] ["Nil" _]]]]]]]]]]]]] - (&&host/analyse-jvm-invokestatic analyse-ast ?class ?method (&/->seq ?classes) (&/->seq ?args)) + (&&host/analyse-jvm-invokestatic analyse ?class ?method (&/->seq ?classes) (&/->seq ?args)) [["Form" ["Cons" [["Ident" "jvm-invokevirtual"] ["Cons" [["Ident" ?class] @@ -248,7 +255,7 @@ ["Cons" [?object ["Cons" [["Tuple" ?args] ["Nil" _]]]]]]]]]]]]]]] - (&&host/analyse-jvm-invokevirtual analyse-ast ?class ?method (&/->seq ?classes) ?object (&/->seq ?args)) + (&&host/analyse-jvm-invokevirtual analyse ?class ?method (&/->seq ?classes) ?object (&/->seq ?args)) [["Form" ["Cons" [["Ident" "jvm-invokeinterface"] ["Cons" [["Ident" ?class] @@ -257,7 +264,7 @@ ["Cons" [?object ["Cons" [["Tuple" ?args] ["Nil" _]]]]]]]]]]]]]]] - (&&host/analyse-jvm-invokeinterface analyse-ast ?class ?method (&/->seq ?classes) ?object (&/->seq ?args)) + (&&host/analyse-jvm-invokeinterface analyse ?class ?method (&/->seq ?classes) ?object (&/->seq ?args)) [["Form" ["Cons" [["Ident" "jvm-invokespecial"] ["Cons" [["Ident" ?class] @@ -266,152 +273,153 @@ ["Cons" [?object ["Cons" [["Tuple" ?args] ["Nil" _]]]]]]]]]]]]]]] - (&&host/analyse-jvm-invokespecial analyse-ast ?class ?method (&/->seq ?classes) ?object (&/->seq ?args)) + (&&host/analyse-jvm-invokespecial analyse ?class ?method (&/->seq ?classes) ?object (&/->seq ?args)) ;; Exceptions [["Form" ["Cons" [["Ident" "jvm-try"] ["Cons" [?body ?handlers]]]]]] - (&&host/analyse-jvm-try analyse-ast ?body (reduce parse-handler [(list) nil] (&/->seq ?handlers))) + (&&host/analyse-jvm-try analyse ?body (reduce parse-handler [(list) nil] (&/->seq ?handlers))) [["Form" ["Cons" [["Ident" "jvm-throw"] ["Cons" [?ex ["Nil" _]]]]]]] - (&&host/analyse-jvm-throw analyse-ast ?ex) + (&&host/analyse-jvm-throw analyse ?ex) ;; Syncronization/monitos [["Form" ["Cons" [["Ident" "jvm-monitorenter"] ["Cons" [?monitor ["Nil" _]]]]]]] - (&&host/analyse-jvm-monitorenter analyse-ast ?monitor) + (&&host/analyse-jvm-monitorenter analyse ?monitor) [["Form" ["Cons" [["Ident" "jvm-monitorexit"] ["Cons" [?monitor ["Nil" _]]]]]]] - (&&host/analyse-jvm-monitorexit analyse-ast ?monitor) + (&&host/analyse-jvm-monitorexit analyse ?monitor) ;; Primitive conversions [["Form" ["Cons" [["Ident" "jvm-d2f"] ["Cons" [?value ["Nil" _]]]]]]] - (&&host/analyse-jvm-d2f analyse-ast ?value) + (&&host/analyse-jvm-d2f analyse ?value) [["Form" ["Cons" [["Ident" "jvm-d2i"] ["Cons" [?value ["Nil" _]]]]]]] - (&&host/analyse-jvm-d2i analyse-ast ?value) + (&&host/analyse-jvm-d2i analyse ?value) [["Form" ["Cons" [["Ident" "jvm-d2l"] ["Cons" [?value ["Nil" _]]]]]]] - (&&host/analyse-jvm-d2l analyse-ast ?value) + (&&host/analyse-jvm-d2l analyse ?value) [["Form" ["Cons" [["Ident" "jvm-f2d"] ["Cons" [?value ["Nil" _]]]]]]] - (&&host/analyse-jvm-f2d analyse-ast ?value) + (&&host/analyse-jvm-f2d analyse ?value) [["Form" ["Cons" [["Ident" "jvm-f2i"] ["Cons" [?value ["Nil" _]]]]]]] - (&&host/analyse-jvm-f2i analyse-ast ?value) + (&&host/analyse-jvm-f2i analyse ?value) [["Form" ["Cons" [["Ident" "jvm-f2l"] ["Cons" [?value ["Nil" _]]]]]]] - (&&host/analyse-jvm-f2l analyse-ast ?value) + (&&host/analyse-jvm-f2l analyse ?value) [["Form" ["Cons" [["Ident" "jvm-i2b"] ["Cons" [?value ["Nil" _]]]]]]] - (&&host/analyse-jvm-i2b analyse-ast ?value) + (&&host/analyse-jvm-i2b analyse ?value) [["Form" ["Cons" [["Ident" "jvm-i2c"] ["Cons" [?value ["Nil" _]]]]]]] - (&&host/analyse-jvm-i2c analyse-ast ?value) + (&&host/analyse-jvm-i2c analyse ?value) [["Form" ["Cons" [["Ident" "jvm-i2d"] ["Cons" [?value ["Nil" _]]]]]]] - (&&host/analyse-jvm-i2d analyse-ast ?value) + (&&host/analyse-jvm-i2d analyse ?value) [["Form" ["Cons" [["Ident" "jvm-i2f"] ["Cons" [?value ["Nil" _]]]]]]] - (&&host/analyse-jvm-i2f analyse-ast ?value) + (&&host/analyse-jvm-i2f analyse ?value) [["Form" ["Cons" [["Ident" "jvm-i2l"] ["Cons" [?value ["Nil" _]]]]]]] - (&&host/analyse-jvm-i2l analyse-ast ?value) + (&&host/analyse-jvm-i2l analyse ?value) [["Form" ["Cons" [["Ident" "jvm-i2s"] ["Cons" [?value ["Nil" _]]]]]]] - (&&host/analyse-jvm-i2s analyse-ast ?value) + (&&host/analyse-jvm-i2s analyse ?value) [["Form" ["Cons" [["Ident" "jvm-l2d"] ["Cons" [?value ["Nil" _]]]]]]] - (&&host/analyse-jvm-l2d analyse-ast ?value) + (&&host/analyse-jvm-l2d analyse ?value) [["Form" ["Cons" [["Ident" "jvm-l2f"] ["Cons" [?value ["Nil" _]]]]]]] - (&&host/analyse-jvm-l2f analyse-ast ?value) + (&&host/analyse-jvm-l2f analyse ?value) [["Form" ["Cons" [["Ident" "jvm-l2i"] ["Cons" [?value ["Nil" _]]]]]]] - (&&host/analyse-jvm-l2i analyse-ast ?value) + (&&host/analyse-jvm-l2i analyse ?value) ;; Bitwise operators [["Form" ["Cons" [["Ident" "jvm-iand"] ["Cons" [?x ["Cons" [?y ["Nil" _]]]]]]]]] - (&&host/analyse-jvm-iand analyse-ast ?x ?y) + (&&host/analyse-jvm-iand analyse ?x ?y) [["Form" ["Cons" [["Ident" "jvm-ior"] ["Cons" [?x ["Cons" [?y ["Nil" _]]]]]]]]] - (&&host/analyse-jvm-ior analyse-ast ?x ?y) + (&&host/analyse-jvm-ior analyse ?x ?y) [["Form" ["Cons" [["Ident" "jvm-land"] ["Cons" [?x ["Cons" [?y ["Nil" _]]]]]]]]] - (&&host/analyse-jvm-land analyse-ast ?x ?y) + (&&host/analyse-jvm-land analyse ?x ?y) [["Form" ["Cons" [["Ident" "jvm-lor"] ["Cons" [?x ["Cons" [?y ["Nil" _]]]]]]]]] - (&&host/analyse-jvm-lor analyse-ast ?x ?y) + (&&host/analyse-jvm-lor analyse ?x ?y) [["Form" ["Cons" [["Ident" "jvm-lxor"] ["Cons" [?x ["Cons" [?y ["Nil" _]]]]]]]]] - (&&host/analyse-jvm-lxor analyse-ast ?x ?y) + (&&host/analyse-jvm-lxor analyse ?x ?y) [["Form" ["Cons" [["Ident" "jvm-lshl"] ["Cons" [?x ["Cons" [?y ["Nil" _]]]]]]]]] - (&&host/analyse-jvm-lshl analyse-ast ?x ?y) + (&&host/analyse-jvm-lshl analyse ?x ?y) [["Form" ["Cons" [["Ident" "jvm-lshr"] ["Cons" [?x ["Cons" [?y ["Nil" _]]]]]]]]] - (&&host/analyse-jvm-lshr analyse-ast ?x ?y) + (&&host/analyse-jvm-lshr analyse ?x ?y) [["Form" ["Cons" [["Ident" "jvm-lushr"] ["Cons" [?x ["Cons" [?y ["Nil" _]]]]]]]]] - (&&host/analyse-jvm-lushr analyse-ast ?x ?y) + (&&host/analyse-jvm-lushr analyse ?x ?y) ;; Arrays [["Form" ["Cons" [["Ident" "jvm-new-array"] ["Cons" [["Ident" ?class] ["Cons" [["Int" ?length] ["Nil" _]]]]]]]]] - (&&host/analyse-jvm-new-array analyse-ast ?class ?length) + (&&host/analyse-jvm-new-array analyse ?class ?length) [["Form" ["Cons" [["Ident" "jvm-aastore"] ["Cons" [?array ["Cons" [["Int" ?idx] ["Cons" [?elem ["Nil" _]]]]]]]]]]] - (&&host/analyse-jvm-aastore analyse-ast ?array ?idx ?elem) + (&&host/analyse-jvm-aastore analyse ?array ?idx ?elem) [["Form" ["Cons" [["Ident" "jvm-aaload"] ["Cons" [?array ["Cons" [["Int" ?idx] ["Nil" _]]]]]]]]] - (&&host/analyse-jvm-aaload analyse-ast ?array ?idx) + (&&host/analyse-jvm-aaload analyse ?array ?idx) ;; Classes & interfaces [["Form" ["Cons" [["Ident" "jvm-class"] ["Cons" [["Ident" ?name] ["Cons" [["Ident" ?super-class] ["Cons" [["Tuple" ?fields] ["Nil" _]]]]]]]]]]] - (&&host/analyse-jvm-class analyse-ast ?name ?super-class (&/->seq ?fields)) + (&&host/analyse-jvm-class analyse ?name ?super-class (&/->seq ?fields)) [["Form" ["Cons" [["Ident" "jvm-interface"] ["Cons" [["Ident" ?name] ?members]]]]]] - (&&host/analyse-jvm-interface analyse-ast ?name ?members) + (&&host/analyse-jvm-interface analyse ?name ?members) ;; Programs [["Form" ["Cons" [["Ident" "jvm-program"] ["Cons" [["Ident" ?args] ["Cons" [?body ["Nil" _]]]]]]]]] - (&&host/analyse-jvm-program analyse-ast ?args ?body) + (&&host/analyse-jvm-program analyse ?args ?body) [_] (fail (str "[Analyser Error] Unmatched token: " (&/show-ast token))))) -(defn ^:private analyse-ast [token] - ;; (prn 'analyse-ast token) - (matchv ::M/objects [token] - [["Form" ["Cons" [["Tag" ?tag] ?values]]]] - (exec [;; :let [_ (prn 'PRE-ASSERT)] - :let [?values (&/->seq ?values)] - :let [_ (assert (= 1 (count ?values)) (str "[Analyser Error] Can only tag 1 value: " (pr-str token)))] - ;; :let [_ (prn 'POST-ASSERT)] - =value (&&/analyse-1 analyse-ast (first ?values)) - =value-type (&&/expr-type =value)] - (return (list [::&&/Expression [::&&/variant ?tag =value] [::&type/Variant (list [?tag =value-type])]]))) - - [["Form" ["Cons" [?fn ?args]]]] - (fn [state] - (match ((&&/analyse-1 analyse-ast ?fn) state) - [::&/ok [state* =fn]] - ((&&lux/analyse-call analyse-ast =fn ?args) state*) - - _ - ((analyse-basic-ast analyse-ast token) state))) - - [_] - (analyse-basic-ast analyse-ast token))) +(defn ^:private analyse-ast [eval!] + (fn [token] + ;; (prn 'analyse-ast token) + (matchv ::M/objects [token] + [["Form" ["Cons" [["Tag" ?tag] ?values]]]] + (exec [;; :let [_ (prn 'PRE-ASSERT)] + :let [?values (&/->seq ?values)] + :let [_ (assert (= 1 (count ?values)) (str "[Analyser Error] Can only tag 1 value: " (pr-str token)))] + ;; :let [_ (prn 'POST-ASSERT)] + =value (&&/analyse-1 (analyse-ast eval!) (first ?values)) + =value-type (&&/expr-type =value)] + (return (|list [::&&/Expression [::&&/variant ?tag =value] (&/V "Variant" (&/V "Cons" (to-array [(to-array [?tag =value-type]) (&/V "Nil" nil)])))]))) + + [["Form" ["Cons" [?fn ?args]]]] + (fn [state] + (match ((&&/analyse-1 (analyse-ast eval!) ?fn) state) + [::&/ok [state* =fn]] + ((&&lux/analyse-apply (analyse-ast eval!) =fn ?args) state*) + + _ + ((analyse-basic-ast (analyse-ast eval!) eval! token) state))) + + [_] + (analyse-basic-ast (analyse-ast eval!) eval! token)))) ;; [Resources] -(def analyse +(defn analyse [eval!] (exec [asts &parser/parse ;; :let [_ (prn 'analyse/asts asts)] ] - (mapcat-m analyse-ast asts))) + (|flat-map% (analyse-ast eval!) asts))) diff --git a/src/lux/analyser/base.clj b/src/lux/analyser/base.clj index 66451e97b..43bcd1181 100644 --- a/src/lux/analyser/base.clj +++ b/src/lux/analyser/base.clj @@ -1,8 +1,10 @@ (ns lux.analyser.base - (:require [clojure.core.match :refer [match]] + (:require [clojure.core.match :as M :refer [match matchv]] + clojure.core.match.array (lux [base :as & :refer [exec return fail try-all-m map-m mapcat-m reduce-m - assert!]]))) + assert!]] + [type :as &type]))) ;; [Resources] (defn expr-type [syntax+] @@ -31,3 +33,11 @@ :else (fail "[Analyser Error] Can't expand to other than 2 elements.")))) + +(defn with-var [k] + (exec [=var &type/fresh-var + =ret (k =var)] + (match =ret + [::Expression ?expr ?type] + (exec [=type (&type/clean =var ?type)] + (return [::Expression ?expr =type]))))) diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj index 0980b2865..9ae2f736b 100644 --- a/src/lux/analyser/case.clj +++ b/src/lux/analyser/case.clj @@ -27,9 +27,11 @@ (defn analyse-branch [analyse max-registers [bindings body]] ;; (prn 'analyse-branch max-registers bindings body) (reduce (fn [body* name] - (&env/with-local name &type/+dont-care-type+ body*)) + (&&/with-var + (fn [=var] + (&env/with-local name =var body*)))) (reduce (fn [body* _] - (&env/with-local "" &type/+dont-care-type+ body*)) + (&env/with-local "" &type/+dont-care+ body*)) (&&/analyse-1 analyse body) (range (- max-registers (count bindings)))) (reverse bindings))) diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj index 59022a0e0..3d94aac59 100644 --- a/src/lux/analyser/host.clj +++ b/src/lux/analyser/host.clj @@ -3,7 +3,8 @@ [clojure.core.match :as M :refer [match matchv]] clojure.core.match.array (lux [base :as & :refer [exec return fail - try-all-m map-m mapcat-m reduce-m + |list + try-all-m map-m reduce-m assert!]] [parser :as &parser] [type :as &type] @@ -29,68 +30,52 @@ (fail "[Analyser Error] Can't extract Ident."))) ;; [Resources] -(do-template [<name> <output-tag> <wrapper-class>] - (let [elem-type [::&type/Data <wrapper-class>]] - (defn <name> [analyse ?x ?y] - (exec [[=x =y] (&&/analyse-2 analyse ?x ?y) - ;; =x-type (&&/expr-type =x) - ;; =y-type (&&/expr-type =y) - ;; _ (&type/solve elem-type =x-type) - ;; _ (&type/solve elem-type =y-type) - ] - (return (list [::&&/Expression [<output-tag> =x =y] elem-type]))))) - - analyse-jvm-iadd ::&&/jvm-iadd "java.lang.Integer" - analyse-jvm-isub ::&&/jvm-isub "java.lang.Integer" - analyse-jvm-imul ::&&/jvm-imul "java.lang.Integer" - analyse-jvm-idiv ::&&/jvm-idiv "java.lang.Integer" - analyse-jvm-irem ::&&/jvm-irem "java.lang.Integer" - - analyse-jvm-ladd ::&&/jvm-ladd "java.lang.Long" - analyse-jvm-lsub ::&&/jvm-lsub "java.lang.Long" - analyse-jvm-lmul ::&&/jvm-lmul "java.lang.Long" - analyse-jvm-ldiv ::&&/jvm-ldiv "java.lang.Long" - analyse-jvm-lrem ::&&/jvm-lrem "java.lang.Long" - - analyse-jvm-fadd ::&&/jvm-fadd "java.lang.Float" - analyse-jvm-fsub ::&&/jvm-fsub "java.lang.Float" - analyse-jvm-fmul ::&&/jvm-fmul "java.lang.Float" - analyse-jvm-fdiv ::&&/jvm-fdiv "java.lang.Float" - analyse-jvm-frem ::&&/jvm-frem "java.lang.Float" - - analyse-jvm-dadd ::&&/jvm-dadd "java.lang.Double" - analyse-jvm-dsub ::&&/jvm-dsub "java.lang.Double" - analyse-jvm-dmul ::&&/jvm-dmul "java.lang.Double" - analyse-jvm-ddiv ::&&/jvm-ddiv "java.lang.Double" - analyse-jvm-drem ::&&/jvm-drem "java.lang.Double" - ) - (do-template [<name> <output-tag> <input-class> <output-class>] - (let [elem-type [::&type/Data <output-class>]] + (let [input-type (&/V "Data" (to-array [<input-class> (&/V "Nil" nil)])) + output-type (&/V "Data" (to-array [<output-class> (&/V "Nil" nil)]))] (defn <name> [analyse ?x ?y] (exec [[=x =y] (&&/analyse-2 analyse ?x ?y) - ;; =x-type (&&/expr-type =x) - ;; =y-type (&&/expr-type =y) - ;; _ (&type/solve elem-type =x-type) - ;; _ (&type/solve elem-type =y-type) - ] - (return (list [::&&/Expression [<output-tag> =x =y] elem-type]))))) - - analyse-jvm-ieq ::&&/jvm-ieq "java.lang.Integer" "java.lang.Boolean" - analyse-jvm-ilt ::&&/jvm-ilt "java.lang.Integer" "java.lang.Boolean" - analyse-jvm-igt ::&&/jvm-igt "java.lang.Integer" "java.lang.Boolean" - - analyse-jvm-leq ::&&/jvm-leq "java.lang.Long" "java.lang.Boolean" - analyse-jvm-llt ::&&/jvm-llt "java.lang.Long" "java.lang.Boolean" - analyse-jvm-lgt ::&&/jvm-lgt "java.lang.Long" "java.lang.Boolean" - - analyse-jvm-feq ::&&/jvm-feq "java.lang.Float" "java.lang.Boolean" - analyse-jvm-flt ::&&/jvm-flt "java.lang.Float" "java.lang.Boolean" - analyse-jvm-fgt ::&&/jvm-fgt "java.lang.Float" "java.lang.Boolean" - - analyse-jvm-deq ::&&/jvm-deq "java.lang.Double" "java.lang.Boolean" - analyse-jvm-dlt ::&&/jvm-dlt "java.lang.Double" "java.lang.Boolean" - analyse-jvm-dgt ::&&/jvm-dgt "java.lang.Double" "java.lang.Boolean" + =x-type (&&/expr-type =x) + =y-type (&&/expr-type =y) + _ (&type/solve input-type =x-type) + _ (&type/solve input-type =y-type)] + (return (|list [::&&/Expression [<output-tag> =x =y] output-type]))))) + + analyse-jvm-iadd ::&&/jvm-iadd "java.lang.Integer" "java.lang.Integer" + analyse-jvm-isub ::&&/jvm-isub "java.lang.Integer" "java.lang.Integer" + analyse-jvm-imul ::&&/jvm-imul "java.lang.Integer" "java.lang.Integer" + analyse-jvm-idiv ::&&/jvm-idiv "java.lang.Integer" "java.lang.Integer" + analyse-jvm-irem ::&&/jvm-irem "java.lang.Integer" "java.lang.Integer" + analyse-jvm-ieq ::&&/jvm-ieq "java.lang.Integer" "java.lang.Boolean" + analyse-jvm-ilt ::&&/jvm-ilt "java.lang.Integer" "java.lang.Boolean" + analyse-jvm-igt ::&&/jvm-igt "java.lang.Integer" "java.lang.Boolean" + + analyse-jvm-ladd ::&&/jvm-ladd "java.lang.Long" "java.lang.Long" + analyse-jvm-lsub ::&&/jvm-lsub "java.lang.Long" "java.lang.Long" + analyse-jvm-lmul ::&&/jvm-lmul "java.lang.Long" "java.lang.Long" + analyse-jvm-ldiv ::&&/jvm-ldiv "java.lang.Long" "java.lang.Long" + analyse-jvm-lrem ::&&/jvm-lrem "java.lang.Long" "java.lang.Long" + analyse-jvm-leq ::&&/jvm-leq "java.lang.Long" "java.lang.Boolean" + analyse-jvm-llt ::&&/jvm-llt "java.lang.Long" "java.lang.Boolean" + analyse-jvm-lgt ::&&/jvm-lgt "java.lang.Long" "java.lang.Boolean" + + analyse-jvm-fadd ::&&/jvm-fadd "java.lang.Float" "java.lang.Float" + analyse-jvm-fsub ::&&/jvm-fsub "java.lang.Float" "java.lang.Float" + analyse-jvm-fmul ::&&/jvm-fmul "java.lang.Float" "java.lang.Float" + analyse-jvm-fdiv ::&&/jvm-fdiv "java.lang.Float" "java.lang.Float" + analyse-jvm-frem ::&&/jvm-frem "java.lang.Float" "java.lang.Float" + analyse-jvm-feq ::&&/jvm-feq "java.lang.Float" "java.lang.Boolean" + analyse-jvm-flt ::&&/jvm-flt "java.lang.Float" "java.lang.Boolean" + analyse-jvm-fgt ::&&/jvm-fgt "java.lang.Float" "java.lang.Boolean" + + analyse-jvm-dadd ::&&/jvm-dadd "java.lang.Double" "java.lang.Double" + analyse-jvm-dsub ::&&/jvm-dsub "java.lang.Double" "java.lang.Double" + analyse-jvm-dmul ::&&/jvm-dmul "java.lang.Double" "java.lang.Double" + analyse-jvm-ddiv ::&&/jvm-ddiv "java.lang.Double" "java.lang.Double" + analyse-jvm-drem ::&&/jvm-drem "java.lang.Double" "java.lang.Double" + analyse-jvm-deq ::&&/jvm-deq "java.lang.Double" "java.lang.Boolean" + analyse-jvm-dlt ::&&/jvm-dlt "java.lang.Double" "java.lang.Boolean" + analyse-jvm-dgt ::&&/jvm-dgt "java.lang.Double" "java.lang.Boolean" ) (defn analyse-jvm-getstatic [analyse ?class ?field] @@ -99,13 +84,13 @@ =type (&host/lookup-static-field =class ?field) ;; :let [_ (prn 'analyse-jvm-getstatic/=type =type)] ] - (return (list [::&&/Expression [::&&/jvm-getstatic =class ?field] =type])))) + (return (|list [::&&/Expression [::&&/jvm-getstatic =class ?field] =type])))) (defn analyse-jvm-getfield [analyse ?class ?field ?object] (exec [=class (&host/full-class-name ?class) =type (&host/lookup-static-field =class ?field) =object (&&/analyse-1 analyse ?object)] - (return (list [::&&/Expression [::&&/jvm-getfield =class ?field =object] =type])))) + (return (|list [::&&/Expression [::&&/jvm-getfield =class ?field =object] =type])))) (defn analyse-jvm-putstatic [analyse ?class ?field ?value] (exec [=class (&host/full-class-name ?class) @@ -113,21 +98,21 @@ =type (&host/lookup-static-field =class ?field) ;; :let [_ (prn 'analyse-jvm-getstatic/=type =type)] =value (&&/analyse-1 analyse ?value)] - (return (list [::&&/Expression [::&&/jvm-putstatic =class ?field =value] =type])))) + (return (|list [::&&/Expression [::&&/jvm-putstatic =class ?field =value] =type])))) (defn analyse-jvm-putfield [analyse ?class ?field ?object ?value] (exec [=class (&host/full-class-name ?class) =type (&host/lookup-static-field =class ?field) =object (&&/analyse-1 analyse ?object) =value (&&/analyse-1 analyse ?value)] - (return (list [::&&/Expression [::&&/jvm-putfield =class ?field =object =value] =type])))) + (return (|list [::&&/Expression [::&&/jvm-putfield =class ?field =object =value] =type])))) (defn analyse-jvm-invokestatic [analyse ?class ?method ?classes ?args] (exec [=class (&host/full-class-name ?class) =classes (map-m &host/extract-jvm-param ?classes) =return (&host/lookup-virtual-method =class ?method =classes) =args (mapcat-m analyse ?args)] - (return (list [::&&/Expression [::&&/jvm-invokestatic =class ?method =classes =args] =return])))) + (return (|list [::&&/Expression [::&&/jvm-invokestatic =class ?method =classes =args] =return])))) (do-template [<name> <tag>] (defn <name> [analyse ?class ?method ?classes ?object ?args] @@ -142,7 +127,7 @@ =args (mapcat-m analyse ?args) ;; :let [_ (prn 'analyse-jvm-invokevirtual/=args =args)] ] - (return (list [::&&/Expression [<tag> =class ?method =classes =object =args] =return])))) + (return (|list [::&&/Expression [<tag> =class ?method =classes =object =args] =return])))) analyse-jvm-invokevirtual ::&&/jvm-invokevirtual analyse-jvm-invokeinterface ::&&/jvm-invokeinterface @@ -151,27 +136,28 @@ (defn analyse-jvm-null? [analyse ?object] (exec [=object (&&/analyse-1 analyse ?object)] - (return (list [::&&/Expression [::&&/jvm-null? =object] [::&type/Data "java.lang.Boolean"]])))) + (return (|list [::&&/Expression [::&&/jvm-null? =object] (&/V "Data" (to-array ["java.lang.Boolean" (&/V "Nil" nil)]))])))) (defn analyse-jvm-new [analyse ?class ?classes ?args] (exec [=class (&host/full-class-name ?class) =classes (map-m &host/extract-jvm-param ?classes) =args (mapcat-m analyse ?args)] - (return (list [::&&/Expression [::&&/jvm-new =class =classes =args] [::&type/Data =class]])))) + (return (|list [::&&/Expression [::&&/jvm-new =class =classes =args] (&/V "Data" (to-array [=class (&/V "Nil" nil)]))])))) (defn analyse-jvm-new-array [analyse ?class ?length] (exec [=class (&host/full-class-name ?class)] - (return (list [::&&/Expression [::&&/jvm-new-array =class ?length] [::&type/Array [::&type/Data =class]]])))) + (return (|list [::&&/Expression [::&&/jvm-new-array =class ?length] (&/V "array" (to-array [(&/V "Data" (to-array [=class (&/V "Nil" nil)])) + (&/V "Nil" nil)]))])))) (defn analyse-jvm-aastore [analyse ?array ?idx ?elem] (exec [[=array =elem] (&&/analyse-2 analyse ?array ?elem) =array-type (&&/expr-type =array)] - (return (list [::&&/Expression [::&&/jvm-aastore =array ?idx =elem] =array-type])))) + (return (|list [::&&/Expression [::&&/jvm-aastore =array ?idx =elem] =array-type])))) (defn analyse-jvm-aaload [analyse ?array ?idx] (exec [=array (&&/analyse-1 analyse ?array) =array-type (&&/expr-type =array)] - (return (list [::&&/Expression [::&&/jvm-aaload =array ?idx] =array-type])))) + (return (|list [::&&/Expression [::&&/jvm-aaload =array ?idx] =array-type])))) (defn analyse-jvm-class [analyse ?name ?super-class ?fields] (exec [?fields (map-m (fn [?field] @@ -186,7 +172,7 @@ [field {:access :public :type class}]))] $module &/get-module-name] - (return (list [::&&/Statement [::&&/jvm-class $module ?name ?super-class =fields {}]])))) + (return (|list [::&&/Statement [::&&/jvm-class $module ?name ?super-class =fields {}]])))) (defn analyse-jvm-interface [analyse ?name ?members] ;; (prn 'analyse-jvm-interface ?name ?members) @@ -211,41 +197,41 @@ [method {:access :public :type [inputs output]}]))] $module &/get-module-name] - (return (list [::&&/Statement [::&&/jvm-interface $module ?name =methods]])))) + (return (|list [::&&/Statement [::&&/jvm-interface $module ?name =methods]])))) (defn analyse-exec [analyse ?exprs] (exec [_ (assert! (count ?exprs) "\"exec\" expressions can't have empty bodies.") =exprs (mapcat-m analyse ?exprs) =exprs-types (map-m &&/expr-type =exprs)] - (return (list [::&&/Expression [::&&/exec =exprs] (last =exprs-types)])))) + (return (|list [::&&/Expression [::&&/exec =exprs] (last =exprs-types)])))) (defn analyse-jvm-try [analyse ?body [?catches ?finally]] (exec [=body (&&/analyse-1 analyse ?body) =catches (map-m (fn [[?ex-class ?ex-arg ?catch-body]] - (&&env/with-local ?ex-arg [::&type/Data ?ex-class] + (&&env/with-local ?ex-arg (&/V "Data" (to-array [?ex-class (&/V "Nil" nil)])) (exec [=catch-body (&&/analyse-1 analyse ?catch-body)] (return [?ex-class ?ex-arg =catch-body])))) ?catches) =finally (&&/analyse-1 analyse ?finally) =body-type (&&/expr-type =body)] - (return (list [::&&/Expression [::&&/jvm-try =body =catches =finally] =body-type])))) + (return (|list [::&&/Expression [::&&/jvm-try =body =catches =finally] =body-type])))) (defn analyse-jvm-throw [analyse ?ex] (exec [=ex (&&/analyse-1 analyse ?ex)] - (return (list [::&&/Expression [::&&/jvm-throw =ex] [::&type/Nothing]])))) + (return (|list [::&&/Expression [::&&/jvm-throw =ex] (&/V "Nothing" nil)])))) (defn analyse-jvm-monitorenter [analyse ?monitor] (exec [=monitor (&&/analyse-1 analyse ?monitor)] - (return (list [::&&/Expression [::&&/jvm-monitorenter =monitor] [::&type/Any]])))) + (return (|list [::&&/Expression [::&&/jvm-monitorenter =monitor] (&/V "Tuple" (&/V "Nil" nil))])))) (defn analyse-jvm-monitorexit [analyse ?monitor] (exec [=monitor (&&/analyse-1 analyse ?monitor)] - (return (list [::&&/Expression [::&&/jvm-monitorexit =monitor] [::&type/Any]])))) + (return (|list [::&&/Expression [::&&/jvm-monitorexit =monitor] (&/V "Tuple" (&/V "Nil" nil))])))) (do-template [<name> <tag> <from-class> <to-class>] (defn <name> [analyse ?value] (exec [=value (&&/analyse-1 analyse ?value)] - (return (list [::&&/Expression [<tag> =value] [::&type/Data <to-class>]])))) + (return (|list [::&&/Expression [<tag> =value] (&/V "Data" (to-array [<to-class> (&/V "Nil" nil)]))])))) analyse-jvm-d2f ::&&/jvm-d2f "java.lang.Double" "java.lang.Float" analyse-jvm-d2i ::&&/jvm-d2i "java.lang.Double" "java.lang.Integer" @@ -270,7 +256,7 @@ (do-template [<name> <tag> <from-class> <to-class>] (defn <name> [analyse ?value] (exec [=value (&&/analyse-1 analyse ?value)] - (return (list [::&&/Expression [<tag> =value] [::&type/Data <to-class>]])))) + (return (|list [::&&/Expression [<tag> =value] (&/V "Data" (to-array [<to-class> (&/V "Nil" nil)]))])))) analyse-jvm-iand ::&&/jvm-iand "java.lang.Integer" "java.lang.Integer" analyse-jvm-ior ::&&/jvm-ior "java.lang.Integer" "java.lang.Integer" @@ -285,6 +271,6 @@ ) (defn analyse-jvm-program [analyse ?args ?body] - (exec [=body (&&env/with-local ?args [::&type/Any] + (exec [=body (&&env/with-local ?args (&/V "Any" nil) (&&/analyse-1 analyse ?body))] - (return (list [::&&/Statement [::&&/jvm-program =body]])))) + (return (|list [::&&/Statement [::&&/jvm-program =body]])))) diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index 077799144..f3d00015d 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -1,8 +1,10 @@ (ns lux.analyser.lux (:require (clojure [template :refer [do-template]]) - [clojure.core.match :refer [match]] + [clojure.core.match :as M :refer [match matchv]] + clojure.core.match.array (lux [base :as & :refer [exec return fail - if-m try-all-m map-m mapcat-m reduce-m + |list + if-m try-all-m |map% |flat-map% |fold% map-m mapcat-m reduce-m assert!]] [parser :as &parser] [type :as &type] @@ -16,24 +18,28 @@ ;; [Resources] (defn analyse-tuple [analyse ?elems] - (exec [=elems (mapcat-m analyse ?elems) - =elems-types (map-m &&/expr-type =elems) + (exec [=elems (|flat-map% analyse ?elems) + =elems-types (|map% &&/expr-type =elems) ;; :let [_ (prn 'analyse-tuple =elems)] ] - (return (list [::&&/Expression [::&&/tuple =elems] [::&type/Tuple =elems-types]])))) + (return (|list [::&&/Expression [::&&/tuple =elems] (&/V "Tuple" (&/|->list =elems-types))])))) (defn analyse-record [analyse ?elems] - (exec [=elems (mapcat-m (fn [[k v]] - (exec [=v (&&/analyse-1 analyse v)] - (return [k =v]))) - ?elems) - =elems-types (map-m (fn [[k v]] - (exec [=v (&&/expr-type v)] - (return [k =v]))) + (exec [=elems (|map% (fn [kv] + (matchv ::M/objects [kv] + [[k v]] + (exec [=v (&&/analyse-1 analyse v)] + (return (to-array [k =v]))))) + ?elems) + =elems-types (|map% (fn [kv] + (matchv ::M/objects [kv] + [[k v]] + (exec [=v (&&/expr-type v)] + (return (to-array [k =v]))))) =elems) ;; :let [_ (prn 'analyse-tuple =elems)] ] - (return (list [::&&/Expression [::&&/record =elems] [::&type/Record =elems-types]])))) + (return (|list [::&&/Expression [::&&/record =elems] (&/V "Record" (&/|->list =elems-types))])))) (defn analyse-ident [analyse ident] (exec [module-name &/get-module-name] @@ -41,13 +47,13 @@ (let [[top & stack*] (::&/local-envs state)] (if-let [=bound (or (get-in top [:locals :mappings ident]) (get-in top [:closure :mappings ident]))] - [::&/ok [state (list =bound)]] + [::&/ok [state (|list =bound)]] (let [no-binding? #(and (-> % :locals :mappings (contains? ident) not) (-> % :closure :mappings (contains? ident) not)) [inner outer] (split-with no-binding? stack*)] (if (empty? outer) (if-let [global (get-in state [::&/global-env ident])] - [::&/ok [state (list global)]] + [::&/ok [state (|list global)]] [::&/failure (str "[Analyser Error] Unresolved identifier: " ident)]) (let [in-stack (cons top inner) scopes (rest (reductions #(cons (:name %2) %1) (map :name outer) (reverse in-stack))) @@ -60,12 +66,23 @@ '()] (map vector (reverse in-stack) scopes) )] - [::&/ok [(assoc state ::&/local-envs (concat inner* outer)) (list =local)]]) + [::&/ok [(assoc state ::&/local-envs (concat inner* outer)) (|list =local)]]) )) )) ))) -(defn analyse-call [analyse =fn ?args] +(defn ^:private analyse-apply* [analyse =fn ?args] + (exec [=args (|flat-map% analyse ?args) + =fn-type (&&/expr-type =fn) + :let [[=apply =apply-type] (|fold% (fn [[=fn =fn-type] =input] + (exec [=input-type (&&/expr-type =input) + =output-type (&type/apply-lambda =fn-type =input-type)] + [[::&&/apply =fn =input] =output-type])) + [=fn =fn-type] + =args)]] + (return (|list [::&&/Expression =apply =apply-type])))) + +(defn analyse-apply [analyse =fn ?args] (exec [loader &/loader] (match =fn [::&&/Expression =fn-form =fn-type] @@ -75,20 +92,18 @@ (if macro? (let [macro-class (&host/location (list ?module ?name))] (exec [macro-expansion (¯o/expand loader macro-class ?args)] - (mapcat-m analyse (&/->seq macro-expansion)))) - (exec [=args (mapcat-m analyse (&/->seq ?args))] - (return (list [::&&/Expression [::&&/call =fn =args] &type/+dont-care-type+]))))) - + (return (&/->seq (|flat-map% analyse macro-expansion))))) + (analyse-apply* analyse =fn ?args))) + _ - (exec [=args (mapcat-m analyse (&/->seq ?args))] - (return (list [::&&/Expression [::&&/call =fn =args] &type/+dont-care-type+])))) + (analyse-apply* analyse =fn ?args)) :else (fail "[Analyser Error] Can't call a statement!")) )) -(defn analyse-case [analyse ?variant ?branches] - ;; (prn 'analyse-case ?variant ?branches) +(defn analyse-case [analyse ?value ?branches] + ;; (prn 'analyse-case ?value ?branches) (exec [:let [num-branches (count ?branches)] _ (assert! (and (> num-branches 0) (even? num-branches)) "[Analyser Error] Unbalanced branches in \"case'\" expression.") @@ -98,37 +113,43 @@ ;; :let [_ (prn '[branches locals-per-branch max-locals] [branches locals-per-branch max-locals])] base-register &&env/next-local-idx ;; :let [_ (prn 'base-register base-register)] - =variant (reduce (fn [body* _] (&&env/with-local "" &type/+dont-care-type+ body*)) - (&&/analyse-1 analyse ?variant) - (range max-locals)) - ;; :let [_ (prn '=variant =variant)] + =value (&&/analyse-1 analyse ?value) + ;; :let [_ (prn '=value =value)] =bodies (map-m (partial &&case/analyse-branch analyse max-locals) (map vector locals-per-branch (map second branches))) ;; :let [_ (prn '=bodies =bodies)] ;; :let [_ (prn 'analyse-case/=bodies =bodies)] =body-types (map-m &&/expr-type =bodies) - =case-type (return [::&type/Any]) ;; (reduce-m &type/merge [::&type/Nothing] =body-types) + =case-type (reduce-m &type/merge (&/V "Nothing" nil) =body-types) :let [=branches (map vector (map first branches) =bodies)]] - (return (list [::&&/Expression [::&&/case =variant base-register max-locals =branches] =case-type])))) + (return (|list [::&&/Expression [::&&/case =value base-register max-locals =branches] =case-type])))) (defn analyse-lambda [analyse ?self ?arg ?body] - (exec [[_ =arg =return :as =lambda-type] &type/fresh-function - [=scope =captured =body] (&&lambda/with-lambda ?self =lambda-type - ?arg =arg - (&&/analyse-1 analyse ?body)) - =body-type (&&/expr-type =body) - =lambda-type (exec [_ (&type/solve =return =body-type)] - (&type/clean =lambda-type))] - (return (list [::&&/Expression [::&&/lambda =scope =captured ?arg =body] =lambda-type])))) + (exec [=lambda-type* &type/fresh-lambda] + (matchv ::M/objects [=lambda-type*] + [["Lambda" [=arg =return]]] + (exec [[=scope =captured =body] (&&lambda/with-lambda ?self =lambda-type* + ?arg =arg + (&&/analyse-1 analyse ?body)) + =body-type (&&/expr-type =body) + =lambda-type (exec [_ (&type/solve =return =body-type) + =lambda-type** (&type/clean =return =lambda-type*)] + (&type/clean =arg =lambda-type**))] + (return (|list [::&&/Expression [::&&/lambda =scope =captured ?arg =body] =lambda-type])))))) (defn analyse-get [analyse ?slot ?record] - (exec [=record (&&/analyse-1 analyse ?record)] - (return (list [::&&/Expression [::&&/get ?slot =record] &type/+dont-care-type+])))) + (exec [=record (&&/analyse-1 analyse ?record) + =record-type (&&/expr-type =record) + =slot-type (&type/slot-type =record-type ?slot)] + (return (|list [::&&/Expression [::&&/get ?slot =record] =slot-type])))) (defn analyse-set [analyse ?slot ?value ?record] (exec [=value (&&/analyse-1 analyse ?value) - =record (&&/analyse-1 analyse ?record)] - (return (list [::&&/Expression [::&&/set ?slot =value =record] &type/+dont-care-type+])))) + =record (&&/analyse-1 analyse ?record) + =record-type (&&/expr-type =record) + =slot-type (&type/slot-type =record-type ?slot) + _ (&type/solve =slot-type =value)] + (return (|list [::&&/Expression [::&&/set ?slot =value =record] =slot-type])))) (defn analyse-def [analyse ?name ?value] ;; (prn 'analyse-def ?name ?value) @@ -138,13 +159,34 @@ (exec [=value (&&/analyse-1 analyse ?value) =value-type (&&/expr-type =value) _ (&&def/define module-name ?name =value-type)] - (return (list [::&&/Statement [::&&/def ?name =value]])))))) + (return (|list [::&&/Statement [::&&/def ?name =value]])))))) (defn analyse-declare-macro [?ident] (exec [module-name &/get-module-name _ (&&def/declare-macro module-name ?ident)] - (return (list)))) + (return (|list)))) (defn analyse-import [analyse ?path] (assert false) - (return (list))) + (return (|list))) + +(defn analyse-check [analyse eval! ?type ?value] + (exec [=type (&&/analyse-1 analyse ?type) + =type-type (&&/expr-type =type) + _ (&type/solve &type/+type+ =type-type) + ==type (eval! =type) + =value (&&/analyse-1 analyse ?value)] + (match =value + [::&&/Expression ?expr ?expr-type] + (exec [_ (&type/solve ==type ?expr-type)] + (return [::&&/Expression ?expr ==type]))))) + +(defn analyse-coerce [analyse eval! ?type ?value] + (exec [=type (&&/analyse-1 analyse ?type) + =type-type (&&/expr-type =type) + _ (&type/solve &type/+type+ =type-type) + ==type (eval! =type) + =value (&&/analyse-1 analyse ?value)] + (match =value + [::&&/Expression ?expr ?expr-type] + (return [::&&/Expression ?expr ==type])))) diff --git a/src/lux/base.clj b/src/lux/base.clj index aa39d591b..d2d06c6ea 100644 --- a/src/lux/base.clj +++ b/src/lux/base.clj @@ -101,17 +101,6 @@ then-m else-m))) -(do-template [<name> <joiner>] - (defn <name> [f inputs] - (if (empty? inputs) - (return '()) - (exec [output (f (first inputs)) - outputs (<name> f (rest inputs))] - (return (<joiner> output outputs))))) - - map-m cons - mapcat-m concat) - (defn reduce-m [f init inputs] (if (empty? inputs) (return init) @@ -208,7 +197,12 @@ ::local-envs (list) ::types +init-bindings+ ::writer nil - ::loader (-> (java.io.File. "./output/") .toURL vector into-array java.net.URLClassLoader.)}) + ::loader (-> (java.io.File. "./output/") .toURL vector into-array java.net.URLClassLoader.) + ::eval-ctor 0}) + +(def get-eval-ctor + (fn [state] + (return* (update-in state [::eval-ctor] inc) (::eval-ctor state)))) (def get-writer (fn [state] @@ -274,9 +268,15 @@ (defn run-state [monad state] (monad state)) +(defn T [& elems] + (to-array elems)) + (defn V [tag value] (to-array [tag value])) +(defn R [& kvs] + (to-array (reduce concat '() kvs))) + (defn ->seq [xs] (matchv ::M/objects [xs] [["Nil" _]] @@ -314,3 +314,64 @@ [["Form" ?elems]] (str "(" (->> (->seq ?elems) (map show-ast) (interpose " ") (apply str)) ")") )) + +(defn |map [f xs] + (matchv ::M/objects [xs] + [["Nil" _]] + xs + + [["Cons" [x xs*]]] + (V "Cons" (to-array [(f x) (|map f xs*)])))) + +(defn |->list [seq] + (reduce (fn [tail head] + (V "Cons" (to-array [head tail]))) + (V "Nil" nil) + seq)) + +(let [cons% (fn [head tail] + (V "Cons" (to-array [head tail]))) + ++% (fn ++% [xs ys] + (matchv ::M/objects [xs] + [["Nil" _]] + ys + + [["Cons" [x xs*]]] + (V "Cons" (to-array [x (++% xs* ys)]))))] + (do-template [<name> <joiner>] + (defn <name> [f xs] + (matchv ::M/objects [xs] + [["Nil" _]] + (return xs) + + [["Cons" [x xs*]]] + (exec [y (f x) + ys (<name> f xs*)] + (return (<joiner> y ys))))) + + |map% cons% + |flat-map% ++%)) + +(defn |fold% [f init xs] + (matchv ::M/objects [xs] + [["Nil" _]] + init + + [["Cons" [x xs*]]] + (|fold% f (f init x) xs*))) + +(defn |get [record slot] + (matchv ::M/objects [record] + [["Nil" _]] + (V "Error" (str "Not found: " slot)) + + [["Cons" [[k v] record*]]] + (if (= k slot) + (V "Ok" v) + (|get record* slot)))) + +(defmacro |list [elems] + (reduce (fn [tail head] + `(V "Cons" (to-array [~head ~tail]))) + `(V "Nil" nil) + elems)) diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index 6fea4f405..6f626c2eb 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -331,7 +331,35 @@ _ (fail "[Compiler Error] Can't compile expressions as top-level forms."))) -(let [compiler-step (exec [analysis+ &optimizer/optimize +(defn ^:private eval! [expr] + (exec [eval-ctor &/get-eval-ctor + :let [class-name (str eval-ctor) + class-file (str class-name ".class") + =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) + (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER) + class-name nil "java/lang/Object" nil) + (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_eval" "Ljava/lang/Object;" nil nil) + (doto (.visitEnd))))] + _ (&/with-writer (.visitMethod =class Opcodes/ACC_PUBLIC "<clinit>" "()V" nil nil) + (exec [*writer* &/get-writer + :let [_ (.visitCode *writer*)] + _ (compile-expression expr) + :let [_ (doto *writer* + (.visitFieldInsn Opcodes/PUTSTATIC class-name "_eval" "Ljava/lang/Object;") + (.visitInsn Opcodes/RETURN) + (.visitMaxs 0 0) + (.visitEnd))]] + (return nil))) + :let [bytecode (.toByteArray (doto =class + .visitEnd))] + _ (&&/save-class! class-file bytecode) + loader &/loader] + (-> (.loadClass loader class-name) + (.getField "_eval") + (.get nil) + return))) + +(let [compiler-step (exec [analysis+ (&optimizer/optimize eval!) ;; :let [_ (prn 'analysis+ analysis+)] ] (mapcat-m compile-statement analysis+))] diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj index 81b8f3981..5d2b06d76 100644 --- a/src/lux/compiler/host.clj +++ b/src/lux/compiler/host.clj @@ -2,7 +2,8 @@ (:require (clojure [string :as string] [set :as set] [template :refer [do-template]]) - [clojure.core.match :refer [match]] + [clojure.core.match :as M :refer [match matchv]] + clojure.core.match.array (lux [base :as & :refer [exec return* return fail fail* repeat-m exhaust-m try-m try-all-m map-m reduce-m apply-m @@ -41,25 +42,24 @@ long-class "java.lang.Long" char-class "java.lang.Character"] (defn prepare-return! [*writer* *type*] - (match *type* - [::&type/Nothing] + (matchv ::M/objects [*type*] + [["Nothing" nil]] (.visitInsn *writer* Opcodes/ACONST_NULL) - [::&type/Data "char"] + [["Data" ["char" _]]] (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host/->class char-class) "valueOf" (str "(C)" (&host/->type-signature char-class))) - [::&type/Data "int"] + [["Data" ["int" _]]] (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host/->class integer-class) "valueOf" (str "(I)" (&host/->type-signature integer-class))) - [::&type/Data "long"] + [["Data" ["long" _]]] (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host/->class long-class) "valueOf" (str "(J)" (&host/->type-signature long-class))) - [::&type/Data "boolean"] + [["Data" ["boolean" _]]] (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host/->class boolean-class) "valueOf" (str "(Z)" (&host/->type-signature boolean-class))) - [::&type/Data _] - nil - ) + [["Data" [_ _]]] + nil) *writer*)) ;; [Resources] diff --git a/src/lux/compiler/lambda.clj b/src/lux/compiler/lambda.clj index 004f09743..c6595fc5e 100644 --- a/src/lux/compiler/lambda.clj +++ b/src/lux/compiler/lambda.clj @@ -66,7 +66,7 @@ $start (new Label) $end (new Label) _ (doto *writer* - (-> (.visitLocalVariable (str &&/local-prefix idx) (&host/->java-sig [::&type/Any]) nil $start $end (+ 2 idx)) + (-> (.visitLocalVariable (str &&/local-prefix idx) (&host/->java-sig (&/V "Any" nil)) nil $start $end (+ 2 idx)) (->> (dotimes [idx num-locals]))) (.visitLabel $start))] ret (compile impl-body) diff --git a/src/lux/host.clj b/src/lux/host.clj index ef4f1ca54..767b331e7 100644 --- a/src/lux/host.clj +++ b/src/lux/host.clj @@ -21,11 +21,11 @@ "") (.getSimpleName class)))] (if (= "void" base) - (return [::&type/Nothing]) - (let [base* [::&type/Data base]] + (return (&/V "Nothing" nil)) + (let [base* (&/V "Data" (to-array [base (&/V "Nil" nil)]))] (if arr-level (return (reduce (fn [inner _] - [::&type/Array inner]) + (&/V "array" (&/V "Cons" (to-array [inner (&/V "Nil" nil)])))) base* (range (/ (count arr-level) 2.0)))) (return base*))) @@ -80,20 +80,20 @@ )) (defn ->java-sig [type] - (match type - [::&type/Any] + (matchv ::M/objects [type] + [["Any" _]] (->type-signature "java.lang.Object") - [::&type/Nothing] + [["Nothing" _]] "V" - [::&type/Data ?name] - (->type-signature ?name) - - [::&type/Array ?elem] + [["Data" ["array" ["Cons" [?elem ["Nil" _]]]]]] (str "[" (->java-sig ?elem)) - [::&type/Lambda _ _] + [["Data" [?name ?params]]] + (->type-signature ?name) + + [["Lambda" [_ _]]] (->type-signature function-class))) (defn extract-jvm-param [token] diff --git a/src/lux/optimizer.clj b/src/lux/optimizer.clj index 0daabe2b5..5c93bfbfb 100644 --- a/src/lux/optimizer.clj +++ b/src/lux/optimizer.clj @@ -13,4 +13,5 @@ ;; Convert pattern-matching on booleans into regular if-then-else structures ;; [Exports] -(def optimize &analyser/analyse) +(defn optimize [eval!] + (&analyser/analyse eval!)) diff --git a/src/lux/parser.clj b/src/lux/parser.clj index f506f5dc2..d60458b2f 100644 --- a/src/lux/parser.clj +++ b/src/lux/parser.clj @@ -10,9 +10,9 @@ (exec [elems (repeat-m parse) token &lexer/lex] (if (= <close-token> token) - (return (list (&/V <tag> (reduce #(&/V "Cons" (to-array [%2 %1])) - (&/V "Nil" nil) - (reverse (apply concat elems)))))) + (return (|list (&/V <tag> (reduce #(&/V "Cons" (to-array [%2 %1])) + (&/V "Nil" nil) + (reverse (apply concat elems)))))) (fail (str "[Parser Error] Unbalanced " <description> "."))))) ^:private parse-form [::&lexer/close-paren] "parantheses" "Form" @@ -30,9 +30,9 @@ (fail (str "[Parser Error] Records must have an even number of elements.")) :else - (return (list (&/V "Record" (reduce #(&/V "Cons" (to-array [%2 %1])) - (&/V "Nil" nil) - (reverse elems)))))))) + (return (|list (&/V "Record" (reduce #(&/V "Cons" (to-array [%2 %1])) + (&/V "Nil" nil) + (reverse elems)))))))) ;; [Interface] (def parse @@ -41,31 +41,31 @@ ] (match token [::&lexer/white-space _] - (return (list)) + (return (|list)) [::&lexer/comment _] - (return (list)) + (return (|list)) [::&lexer/bool ?value] - (return (list (&/V "Bool" (Boolean/parseBoolean ?value)))) + (return (|list (&/V "Bool" (Boolean/parseBoolean ?value)))) [::&lexer/int ?value] - (return (list (&/V "Int" (Integer/parseInt ?value)))) + (return (|list (&/V "Int" (Integer/parseInt ?value)))) [::&lexer/real ?value] - (return (list (&/V "Real" (Float/parseFloat ?value)))) + (return (|list (&/V "Real" (Float/parseFloat ?value)))) [::&lexer/char ?value] - (return (list (&/V "Char" (.charAt ?value 0)))) + (return (|list (&/V "Char" (.charAt ?value 0)))) [::&lexer/text ?value] - (return (list (&/V "Text" ?value))) + (return (|list (&/V "Text" ?value))) [::&lexer/ident ?value] - (return (list (&/V "Ident" ?value))) + (return (|list (&/V "Ident" ?value))) [::&lexer/tag ?value] - (return (list (&/V "Tag" ?value))) + (return (|list (&/V "Tag" ?value))) [::&lexer/open-paren] (parse-form parse) diff --git a/src/lux/type.clj b/src/lux/type.clj index 339a030d9..9c3e6f35b 100644 --- a/src/lux/type.clj +++ b/src/lux/type.clj @@ -1,7 +1,9 @@ (ns lux.type (:refer-clojure :exclude [deref apply merge]) - (:require [clojure.core.match :refer [match]] + (:require [clojure.core.match :as M :refer [match matchv]] + clojure.core.match.array [lux.base :as & :refer [exec return* return fail fail* + |get repeat-m try-m try-all-m map-m sequence-m apply-m assert!]])) @@ -11,326 +13,261 @@ (defn ^:private deref [id] (fn [state] - (if-let [top+bottom (get-in state [::&/types :mappings id])] - [::&/ok [state top+bottom]] + (if-let [type (get-in state [::&/types :mappings id])] + [::&/ok [state type]] [::&/failure (str "Unknown type-var: " id)]))) -(defn ^:private update [id top bottom] +(defn ^:private reset [id type] (fn [state] - (if-let [top+bottom (get-in state [::&/types :mappings id])] - [::&/ok [(assoc-in state [::&/types :mappings id] [top bottom]) nil]] + (if-let [_ (get-in state [::&/types :mappings id])] + [::&/ok [(assoc-in state [::&/types :mappings id] (&/V "Some" type)) nil]] [::&/failure (str "Unknown type-var: " id)]))) -;; [Interface] +;; [Exports] (def fresh-var (fn [state] (let [id (-> state ::&/types :counter)] [::&/ok [(update-in state [::&/types] #(-> % (update-in [:counter] inc) - (assoc-in [:mappings id] [[::Any] [::Nothing]]))) - [::Var id]]]))) + (assoc-in [:mappings id] (&/V "None" nil)))) + (&/V "Var" id)]]))) -(def fresh-function +(def fresh-lambda (exec [=arg fresh-var =return fresh-var] - (return [::Lambda =arg =return]))) - -;; (defn solve [expected actual] -;; ;; (prn 'solve expected actual) -;; (match [expected actual] -;; [::any _] -;; success - -;; [_ ::nothing] -;; success - -;; [_ [::var ?id]] -;; (exec [[=top =bottom] (deref ?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] (deref ?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)) - -;; [[::primitive ?e-prim] [::primitive ?a-prim]] -;; (if (= ?e-prim ?a-prim) -;; success -;; (fail (str "Can't solve types: " (pr-str expected 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)]))) + (return (&/V "Lambda" (to-array [=arg =return]))))) + +(defn ^:private ->type [pseudo-type] + (match pseudo-type + [::Any] + (&/V "Any" nil) + + [::Nothing] + (&/V "Nothing" nil) + + [::Data ?name ?elems] + (&/V "Data" (to-array [?name ?elems])) + + [::Tuple ?members] + (&/V "Tuple" (&/|map ->type ?members)) + + [::Variant ?members] + (&/V "Variant" (&/|map (fn [[k v]] (to-array [k (->type v)])) + ?members)) + + [::Record ?members] + (&/V "Record" (&/|map (fn [[k v]] (to-array [k (->type v)])) + ?members)) + + [::Lambda ?input ?output] + (&/V "Lambda" (to-array [(->type ?input) (->type ?output)])) + + [::App ?lambda ?param] + (&/V "App" (to-array [(->type ?lambda) (->type ?param)])) + + [::Bound ?name] + (&/V "Bound" ?name) -(defn clean [type] - (match type [::Var ?id] - (exec [[=top =bottom] (deref ?id)] - (clean =top)) + (&/V "Var" ?id) + + [::All ?env ?name ?arg ?body] + (&/V "All" (to-array [(&/|map (fn [[k v]] (to-array [k (->type v)])) + ?env) + ?name + ?arg + (->type ?body)])) + )) + +(def +list+ + [::All (&/|->list (list)) "List" "a" + [::Variant (&/|->list (list ["Cons" [::Tuple (&/|->list (list [::Bound "a"] [::App [::Bound "List"] [::Bound "a"]]))]] + ["Nil" [::Tuple (&/|->list (list))]] + ))]]) + +(def +type+ + (let [text [::Data "java.lang.String" (&/|->list (list))] + type [::App [::Bound "Type"] [::Any]] + list-of-types [::App +list+ type] + string=>type [::App +list+ [::Tuple (&/|->list (list text type))]]] + (->type [::All (&/|->list (list)) "Type" "_" + [::Variant (&/|->list (list ["Any" [::Tuple (&/|->list (list))]] + ["Nothing" [::Tuple (&/|->list (list))]] + ["Data" [::Tuple (&/|->list (list text list-of-types))]] + ["Tuple" list-of-types] + ["Variant" string=>type] + ["Record" string=>type] + ["Lambda" [::Tuple (&/|->list (list type + type))]] + ["App" [::Tuple (&/|->list (list type + type))]] + ["Bound" text] + ["Var" [::Data "java.lang.Long" (&/|->list (list))]] + ["All" [::Tuple (&/|->list (list string=>type text text type))]] + ))]]))) - [::Lambda ?arg ?return] +(defn clean [type] + (matchv ::M/objects [type] + [["Var" ?id]] + (exec [=type (deref ?id)] + (clean =type)) + + [["Lambda" [?arg ?return]]] (exec [=arg (clean ?arg) =return (clean ?return)] - (return [::Lambda =arg =return])) + (return (&/V "Lambda" (to-array [=arg =return])))) + + [["App" [?lambda ?param]]] + (exec [=lambda (clean ?lambda) + =param (clean ?param)] + (return (&/V "App" (to-array [=lambda =param])))) - _ + [["Tuple" ?members]] + (exec [=members (&/|map% clean ?members)] + (return (&/V "Tuple" =members))) + + [["Variant" ?members]] + (exec [=members (&/|map% (fn [[k v]] + (exec [=v (clean v)] + (return (to-array [k =v])))) + ?members)] + (return (&/V "Variant" =members))) + + [["Record" ?members]] + (exec [=members (&/|map% (fn [[k v]] + (exec [=v (clean v)] + (return (to-array [k =v])))) + ?members)] + (return (&/V "Record" =members))) + + [["All" [?env ?name ?arg ?body]]] + (exec [=env (&/|map% (fn [[k v]] + (exec [=v (clean v)] + (return (to-array [k =v])))) + ?env)] + (return (&/V "All" (to-array [=env ?name ?arg ?body])))) + + [_] (return type) )) -;; Java Reflection -(def success (return nil)) - -(defn solve [needed given] - (match [needed given] - [[::Any] _] +(defn solve [expected actual] + (matchv ::M/objects [expected actual] + [["Any" _] _] success - [_ [::Nothing]] + [_ ["Nothing" _]] success - [[::Data n!name] [::Data g!name]] - (cond (or (= n!name g!name) - (.isAssignableFrom (Class/forName n!name) (Class/forName g!name))) - success - - :else - (fail (str "not (" given " <= " needed ")"))) + [["Data" [e!name e!params]] ["Data" [a!name a!params]]] + (if (or (= e!name a!name) + (.isAssignableFrom (Class/forName e!name) (Class/forName a!name))) + success + (fail (str "not (" actual " <= " expected ")"))) - [[::Tuple n!elems] [::Tuple g!elems]] - (exec [_ (assert! (= (count n!elems) (count g!elems)) + [["Tuple" e!elems] ["Tuple" a!elems]] + (exec [:let [e!elems (&/->seq e!elems) + a!elems (&/->seq a!elems)] + _ (assert! (= (count e!elems) (count a!elems)) "Tuples must have matching element sizes.") _ (map-m (fn [n g] (solve n g)) - (map vector n!elems g!elems))] + (map vector e!elems a!elems))] success) - [[::Variant n!cases] [::Variant g!cases]] - (exec [_ (assert! (every? (partial contains? n!cases) (keys g!cases)) + [["Variant" e!cases] ["Variant" a!cases]] + (exec [:let [e!cases (reduce #(assoc %1 (aget %2 0) (aget %2 1)) {} (&/->seq e!cases)) + a!cases (reduce #(assoc %1 (aget %2 0) (aget %2 1)) {} (&/->seq a!cases))] + _ (assert! (every? (partial contains? e!cases) (keys a!cases)) "The given variant contains unhandled cases.") _ (map-m (fn [label] - (solve (get n!cases label) (get g!cases label))) - (keys g!cases))] + (solve (get e!cases label) (get a!cases label))) + (keys a!cases))] success) - [[::Record n!fields] [::Record g!fields]] - (exec [_ (assert! (every? (partial contains? g!fields) (keys n!fields)) + [["Record" e!fields] ["Record" a!fields]] + (exec [:let [e!fields (reduce #(assoc %1 (aget %2 0) (aget %2 1)) {} (&/->seq e!fields)) + a!fields (reduce #(assoc %1 (aget %2 0) (aget %2 1)) {} (&/->seq a!fields))] + _ (assert! (every? (partial contains? a!fields) (keys e!fields)) "The given record lacks necessary fields.") _ (map-m (fn [label] - (solve (get n!fields label) (get g!fields label))) - (keys n!fields))] + (solve (get e!fields label) (get a!fields label))) + (keys e!fields))] success) - [[::Lambda n!input n!output] [::Lambda g!input g!output]] - (exec [_ (solve g!input n!input)] - (solve n!output g!output)) + [["Lambda" [e!input e!output]] ["Lambda" [a!input a!output]]] + (exec [_ (solve a!input e!input)] + (solve e!output a!output)) - [[::Var n!id] _] - (exec [[n!top n!bottom] (deref n!id) - _ (solve n!top given) - _ (solve given n!bottom) - _ (update n!id n!top given)] + [["Var" e!id] _] + (exec [=e!type (deref e!id) + _ (solve =e!type actual) + _ (reset e!id =e!type)] + success) + + [_ ["Var" a!id]] + (exec [=a!type (deref a!id) + _ (solve expected =a!type) + _ (reset a!id =a!type)] success) )) (let [&& #(and %1 %2)] (defn merge [x y] - (match [x y] - [_ [::Nothing]] + (matchv ::M/objects [x y] + [_ ["Any" _]] + (return y) + + [["Any" _] _] (return x) - [[::Nothing] _] + [_ ["Nothing" _]] + (return x) + + [["Nothing" _] _] (return y) - [[::Variant x!cases] [::Variant y!cases]] - (if (and (reduce && true - (for [[xslot xtype] (keys x!cases)] - (if-let [ytype (get y!cases xslot)] - (= xtype ytype) - true))) - (reduce && true - (for [[yslot ytype] (keys y!cases)] - (if-let [xtype (get x!cases yslot)] - (= xtype ytype) - true)))) - (return [::Variant (clojure.core/merge x!cases y!cases)]) - (fail (str "Incompatible variants: " (pr-str x) " and " (pr-str y)))) - - [[::Record x!fields] [::Record y!fields]] - (if (and (= (keys x!fields) (keys y!fields)) - (->> (keys x!fields) - (map #(= (get x!fields %) (get y!fields %))) - (reduce && true))) - (return x) - (fail (str "Incompatible records: " (pr-str x) " and " (pr-str y)))) + ;; [["Variant" x!cases] ["Variant" y!cases]] + ;; (if (and (reduce && true + ;; (for [[xslot xtype] (keys x!cases)] + ;; (if-let [ytype (get y!cases xslot)] + ;; (= xtype ytype) + ;; true))) + ;; (reduce && true + ;; (for [[yslot ytype] (keys y!cases)] + ;; (if-let [xtype (get x!cases yslot)] + ;; (= xtype ytype) + ;; true)))) + ;; (return (&/V "Variant" (clojure.core/merge x!cases y!cases))) + ;; (fail (str "Incompatible variants: " (pr-str x) " and " (pr-str y)))) + + ;; [["Record" x!fields] ["Record" y!fields]] + ;; (if (and (= (keys x!fields) (keys y!fields)) + ;; (->> (keys x!fields) + ;; (map #(= (get x!fields %) (get y!fields %))) + ;; (reduce && true))) + ;; (return x) + ;; (fail (str "Incompatible records: " (pr-str x) " and " (pr-str y)))) - :else + [_ _] (fail (str "Can't merge types: " (pr-str x) " and " (pr-str y)))))) -(def +dont-care-type+ [::Any]) - -(comment - ;; Types - [::Any] - [::Nothing] - [::Tuple (list)] - [::Lambda input output] - [::Variant {}] - [::Record {}] - [::Data name] - [::All self {} arg body] - [::Exists evar body] - [::Bound name] - - ;; ??? - [::Alias name args type] - [::Var id] - - - ;; (deftype #rec Type - ;; (| #Any - ;; #Nothing - ;; (#Tuple (List Type)) - ;; (#Lambda Type Type) - ;; (#Variant (List [Text Type])) - ;; (#Record (List [Text Type])) - ;; (#Data Text))) - - - - ;; (deftype #rec Kind - ;; (| (#Type Type) - ;; (#All Text (List [Text Kind]) Text Kind))) - - ;; (deftype (Higher lower) - ;; (| (#Lower lower) - ;; (#Apply (Higher lower) (Higher lower)) - ;; (#All Text (List [Text lower]) Text (Higher lower)) - ;; (#Exists (List [Text lower]) Text (Higher lower)))) - - ;; (deftype Kind (Higher Type)) - ;; (deftype Sort (Higher Kind)) - - - - ;; (deftype HList (| (#Cons (Exists x x) HList) - ;; #Nil)) - - ;; (def success (return nil)) - - ;; (defn apply [type-lambda input] - ;; (match type-lambda - ;; [::All ?self ?env ?arg ?body] - ;; (let [env* (-> ?env - ;; (assoc ?arg input) - ;; (assoc ?self type-lambda))] - ;; (match ?body - ;; [::All ?sub-self _ ?sub-arg ?sub-body] - ;; [::All ?sub-self env* ?sub-arg ?sub-body] - - ;; _ - ;; (beta-reduce env* ?body))))) - - ;; (defn solve [needed given] - ;; (match [needed given] - ;; [[::Any] _] - ;; success - - ;; [_ [::Nothing]] - ;; success - - ;; [[::Tuple n!elems] [::Tuple g!elems]] - ;; (exec [_ (assert! (= (count n!elems) (count g!elems)) - ;; "Tuples must have matching element sizes.") - ;; _ (map-m (fn [[n g]] (solve n g)) - ;; (map vector n!elems g!elems))] - ;; success) - - ;; [[::Variant n!cases] [::Variant g!cases]] - ;; (exec [_ (assert! (every? (partial contains? n!cases) (keys g!cases)) - ;; "The given variant contains unhandled cases.") - ;; _ (map-m (fn [label] - ;; (solve (get n!cases label) (get g!cases label))) - ;; (keys g!cases))] - ;; success) - - ;; [[::Record n!fields] [::Record g!fields]] - ;; (exec [_ (assert! (every? (partial contains? g!fields) (keys n!fields)) - ;; "The given record lacks necessary fields.") - ;; _ (map-m (fn [label] - ;; (solve (get n!fields label) (get g!fields label))) - ;; (keys n!fields))] - ;; success) - - ;; [[::Lambda n!input n!output] [::Lambda g!input g!output]] - ;; (exec [_ (solve g!input n!input) - ;; _ (solve n!output g!output)] - ;; success) - ;; )) - - ;; (deftype (List x) - ;; (| (#Cons x (List x)) - ;; #Nil)) - - ;; (deftype List - ;; (All List [x] - ;; (| (#Cons x (List x)) - ;; #Nil))) - - ;; (def List - ;; [::All "List" {} x - ;; [::Variant {"Cons" [::Tuple (list [::Local x] [::Apply {} [::Local "List"] [::Local x]])] - ;; "Nil" [::Tuple (list)]}]]) - - ;; (deftype User - ;; {#name Text - ;; #email Text - ;; #password Text - ;; #joined Time - ;; #last-login Time}) - - ;; (deftype (Pair x y) - ;; [x y]) - - ;; (deftype (State s a) - ;; (-> s [a s])) - - ;; (: + (-> Int Int Int)) - ;; (def (+ x y) - ;; (jvm:ladd x y)) - - - ) +(defn apply-lambda [func param] + (matchv ::M/objects [func] + [["Lambda" [input output]]] + (exec [_ (solve input param)] + (return output)) + + [_] + (fail (str "Can't apply type " (str func) " to type " (str param))))) + +(defn slot-type [record slot] + (fn [state] + (matchv ::M/objects [(|get record slot)] + [["Error" msg]] + (fail* msg) + + [["Ok" type]] + (return* state type)))) + +(def +dont-care+ (&/V "Any" nil)) |