From 4f35491020fba914b746b4109f4362de603288bc Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 21 Mar 2015 18:17:24 -0400 Subject: - Added module-name aliasing. --- source/lux.lux | 214 +++++++++++++++------------- src/lux.clj | 1 - src/lux/analyser.clj | 339 ++++++++++++++++++++++---------------------- src/lux/analyser/base.clj | 4 +- src/lux/analyser/case.clj | 8 +- src/lux/analyser/def.clj | 49 ++++--- src/lux/analyser/env.clj | 26 ++-- src/lux/analyser/host.clj | 45 +++--- src/lux/analyser/lambda.clj | 9 +- src/lux/analyser/lux.clj | 143 ++++++++++--------- src/lux/base.clj | 281 ++++++++++++++++++------------------ src/lux/compiler.clj | 34 ++--- src/lux/compiler/base.clj | 176 +++++++++++------------ src/lux/compiler/case.clj | 28 ++-- src/lux/compiler/host.clj | 34 ++--- src/lux/compiler/lambda.clj | 6 +- src/lux/host.clj | 22 +-- src/lux/lexer.clj | 50 +++++-- src/lux/macro.clj | 13 ++ src/lux/parser.clj | 24 ++-- src/lux/type.clj | 174 +++++++++++------------ 21 files changed, 885 insertions(+), 795 deletions(-) diff --git a/source/lux.lux b/source/lux.lux index 427057386..fd895f25c 100644 --- a/source/lux.lux +++ b/source/lux.lux @@ -9,7 +9,11 @@ (case' tokens (#Cons [lhs (#Cons [rhs (#Cons [body #Nil])])]) (#Right [state - (#Cons [(#Form (#Cons [(#Symbol "case'") (#Cons [rhs (#Cons [lhs (#Cons [body #Nil])])])])) + (#Cons [(#Form (#Cons [(#Symbol ["" "case'"]) + (#Cons [rhs + (#Cons [lhs + (#Cons [body + #Nil])])])])) #Nil])])) ))) (declare-macro let') @@ -19,21 +23,21 @@ (lambda' _ state (let' output (case' tokens (#Cons [(#Tuple (#Cons [arg args'])) (#Cons [body #Nil])]) - (#Form (#Cons [(#Symbol "lambda'") - (#Cons [(#Symbol "") + (#Form (#Cons [(#Symbol ["" "lambda'"]) + (#Cons [(#Symbol ["" ""]) (#Cons [arg (#Cons [(case' args' #Nil body _ - (#Form (#Cons [(#Symbol "lux;lambda") + (#Form (#Cons [(#Symbol ["lux" "lambda"]) (#Cons [(#Tuple args') (#Cons [body #Nil])])]))) #Nil])])])])) (#Cons [(#Symbol self) (#Cons [(#Tuple (#Cons [arg args'])) (#Cons [body #Nil])])]) - (#Form (#Cons [(#Symbol "lambda'") + (#Form (#Cons [(#Symbol ["" "lambda'"]) (#Cons [(#Symbol self) (#Cons [arg (#Cons [(case' args' @@ -41,7 +45,7 @@ body _ - (#Form (#Cons [(#Symbol "lux;lambda") + (#Form (#Cons [(#Symbol ["lux" "lambda"]) (#Cons [(#Tuple args') (#Cons [body #Nil])])]))) #Nil])])])]))) @@ -53,13 +57,13 @@ (lambda [tokens state] (let' output (case' tokens (#Cons [(#Symbol name) (#Cons [body #Nil])]) - (#Form (#Cons [(#Symbol "def'") tokens])) + (#Form (#Cons [(#Symbol ["lux" "def'"]) tokens])) (#Cons [(#Form (#Cons [(#Symbol name) args])) (#Cons [body #Nil])]) - (#Form (#Cons [(#Symbol "def'") + (#Form (#Cons [(#Symbol ["lux" "def'"]) (#Cons [(#Symbol name) - (#Cons [(#Form (#Cons [(#Symbol "lux;lambda") + (#Cons [(#Form (#Cons [(#Symbol ["lux" "lambda"]) (#Cons [(#Symbol name) (#Cons [(#Tuple args) (#Cons [body #Nil])])])])) @@ -69,14 +73,14 @@ (def (defmacro tokens state) (let' [fn-name fn-def] (case' tokens - (#Cons [(#Form (#Cons [(#Symbol name) args])) + (#Cons [(#Form (#Cons [(#Symbol fn-name) args])) (#Cons [body #Nil])]) - [name - (#Form (#Cons [(#Symbol "lux;def") - (#Cons [(#Form (#Cons [(#Symbol name) args])) + [fn-name + (#Form (#Cons [(#Symbol ["lux" "def"]) + (#Cons [(#Form (#Cons [(#Symbol fn-name) args])) (#Cons [body #Nil])])]))]) - (let' declaration (#Form (#Cons [(#Symbol "declare-macro") (#Cons [(#Symbol fn-name) #Nil])])) + (let' declaration (#Form (#Cons [(#Symbol ["lux" "declare-macro"]) (#Cons [(#Symbol fn-name) #Nil])])) (#Right [state (#Cons [fn-def (#Cons [declaration #Nil])])])))) (declare-macro defmacro) @@ -114,10 +118,10 @@ (defmacro (list xs state) (let' xs' (reverse xs) (let' output (fold (lambda [tail head] - (#Form (#Cons [(#Tag "Cons") + (#Form (#Cons [(#Tag ["lux" "Cons"]) (#Cons [(#Tuple (#Cons [head (#Cons [tail #Nil])])) #Nil])]))) - (#Tag "Nil") + (#Tag ["lux" "Nil"]) xs') (#Right [state (#Cons [output #Nil])])))) @@ -128,7 +132,7 @@ (#Cons [last init']) (let' output (fold (lambda [tail head] - (#Form (list (#Tag "Cons") (#Tuple (list head tail))))) + (#Form (list (#Tag ["lux" "Cons"]) (#Tuple (list head tail))))) last init') (#Right [state (#Cons [output #Nil])])))) @@ -147,7 +151,7 @@ (let' output (fold (lambda [body binding] (case' binding [label value] - (#Form (list (#Symbol "lux;let'") label value body)))) + (#Form (list (#Symbol ["lux" "let'"]) label value body)))) body (reverse (as-pairs bindings))) (#Right [state (list output)])))) @@ -179,44 +183,44 @@ (def (untemplate-list tokens) (case' tokens #Nil - (#Tag "Nil") + (#Tag ["lux" "Nil"]) (#Cons [token tokens']) - (#Form (#Cons [(#Tag "Cons") + (#Form (#Cons [(#Tag ["lux" "Cons"]) (#Cons [(#Tuple (#Cons [token (#Cons [(untemplate-list tokens') #Nil])])) #Nil])])))) (def (untemplate token) (case' token (#Bool value) - (#Form (list (#Tag "Bool") (#Bool value))) + (#Form (list (#Tag ["lux" "Bool"]) (#Bool value))) (#Int value) - (#Form (list (#Tag "Int") (#Int value))) + (#Form (list (#Tag ["lux" "Int"]) (#Int value))) (#Real value) - (#Form (list (#Tag "Real") (#Real value))) + (#Form (list (#Tag ["lux" "Real"]) (#Real value))) (#Char value) - (#Form (list (#Tag "Char") (#Char value))) + (#Form (list (#Tag ["lux" "Char"]) (#Char value))) (#Text value) - (#Form (list (#Tag "Text") (#Text value))) + (#Form (list (#Tag ["lux" "Text"]) (#Text value))) - (#Tag value) - (#Form (list (#Tag "Tag") (#Text value))) + (#Tag [module name]) + (#Form (list (#Tag ["lux" "Tag"]) (#Tuple (list (#Text module) (#Text name))))) - (#Symbol value) - (#Form (list (#Tag "Symbol") (#Text value))) + (#Symbol [module name]) + (#Form (list (#Tag ["lux" "Symbol"]) (#Tuple (list (#Text module) (#Text name))))) (#Tuple elems) - (#Form (list (#Tag "Tuple") (untemplate-list (map untemplate elems)))) + (#Form (list (#Tag ["lux" "Tuple"]) (untemplate-list (map untemplate elems)))) - (#Form (#Cons [(#Symbol "~") (#Cons [unquoted #Nil])])) + (#Form (#Cons [(#Symbol [_ "~"]) (#Cons [unquoted #Nil])])) unquoted (#Form elems) - (#Form (list (#Tag "Form") (untemplate-list (map untemplate elems)))) + (#Form (list (#Tag ["lux" "Form"]) (untemplate-list (map untemplate elems)))) )) (defmacro (` tokens state) @@ -273,8 +277,8 @@ (case' tokens (#Cons [bindings (#Cons [body #Nil])]) (let [pairs (as-pairs bindings)] - (return (list (#Form (#Cons [(` (lambda (~ (#Symbol "recur")) (~ (#Tuple (map first pairs))) - (~ body))) + (return (list (#Form (#Cons [(` (lambda (~ (#Symbol ["lux" "recur"])) (~ (#Tuple (map first pairs))) + (~ body))) (map second pairs)]))))))) (defmacro (export tokens) @@ -404,14 +408,14 @@ #Nil true _ false)) -## (do-template [ ] -## (def ( p xs) -## (case xs -## #Nil true -## (#Cons [x xs']) ( (p x) ( p xs')))) +## ## (do-template [ ] +## ## (def ( p xs) +## ## (case xs +## ## #Nil true +## ## (#Cons [x xs']) ( (p x) ( p xs')))) -## [every? and] -## [any? or]) +## ## [every? and] +## ## [any? or]) (def (range from to) (if (int< from to) @@ -444,7 +448,7 @@ (def (get-ident x) (case' x - (#Symbol ident) + (#Symbol [_ ident]) ident)) (def (text-++ x y) @@ -456,7 +460,7 @@ (def (apply-template env template) (case' template - (#Symbol ident) + (#Symbol [_ ident]) (case' (get ident env) (#Some subst) subst @@ -490,11 +494,11 @@ (map (. apply (zip2 bindings-list))) return)))) -## (do-template [ ] -## (def (int+ )) +## ## (do-template [ ] +## ## (def (int+ )) -## [inc 1] -## [dec -1]) +## ## [inc 1] +## ## [dec -1]) (def (int= x y) (jvm-leq x y)) @@ -587,19 +591,19 @@ (jvm-invokevirtual java.lang.Object "toString" [] int [])) -## (def gensym -## (lambda [state] -## [(update@ #gen-seed inc state) -## (#Symbol ($ text-++ "__" (show-int (get@ #gen-seed state)) "__"))])) +## ## (def gensym +## ## (lambda [state] +## ## [(update@ #gen-seed inc state) +## ## (#Symbol ($ text-++ "__" (show-int (get@ #gen-seed state)) "__"))])) -## ## (do-template [ ] -## ## (def ( pair) -## ## (case' pair -## ## [f s] -## ## )) +## ## ## (do-template [ ] +## ## ## (def ( pair) +## ## ## (case' pair +## ## ## [f s] +## ## ## )) -## ## [first f] -## ## [second s]) +## ## ## [first f] +## ## ## [second s]) (def (show-syntax syntax) (case' syntax @@ -623,11 +627,11 @@ (jvm-invokevirtual java.lang.Object "toString" [] value []) - (#Symbol ident) - ident + (#Symbol [module name]) + ($ text-++ module ";" name) - (#Tag tag) - (text-++ "#" tag) + (#Tag [module name]) + ($ text-++ "#" module ";" name) (#Tuple members) ($ text-++ "[" (fold text-++ "" (interpose " " (map show-syntax members))) "]") @@ -663,8 +667,8 @@ (#Cons [(#Tuple fields) #Nil]) (return (list (#Record (map (lambda [slot] (case' slot - (#Tag name) - [(#Tag name) (#Symbol name)])) + (#Tag [module name]) + [($ text-++ module ";" name) (#Symbol [module name])])) fields)))))) (defmacro ($or tokens) @@ -677,30 +681,33 @@ (defmacro (^ tokens) (case' tokens - (#Cons [(#Symbol class-name) #Nil]) - (return (list (` (#Data [(~ (#Text class-name)) (list)])))))) + (#Cons [(#Symbol [_ class-name]) #Nil]) + (return (list (` (#Data [(~ (#Text class-name)) (list)])))) + + (#Cons [(#Symbol [_ class-name]) (#Cons [(#Tuple params) #Nil])]) + (return (list (` (#Data [(~ (#Text class-name)) (~ (untemplate-list params))])))))) (defmacro (, members) - (return (list (#Form (list+ (#Tag "Tuple") (untemplate-list members)))))) + (return (list (#Form (list+ (#Tag ["lux" "TTuple"]) (untemplate-list members)))))) (defmacro (| members) (let [members' (map (lambda [m] (case' m - (#Tag tag) - [tag (` (#Tuple (list)))] + (#Tag [module name]) + [($ text-++ module ";" name) (` (#Tuple (list)))] - (#Form (#Cons [tag (#Cons [value #Nil])])) - [tag (` (#Tuple (~ value)))])) + (#Form (#Cons [(#Tag [module name]) (#Cons [value #Nil])])) + [($ text-++ module ";" name) (` (#Tuple (~ value)))])) members)] - (return (list (#Form (list+ (#Tag "Variant") (untemplate-list members))))))) + (return (list (#Form (list+ (#Tag ["lux" "TVariant"]) (untemplate-list members))))))) (defmacro (& members) (let [members' (map (lambda [m] (case' m - (#Form (#Cons [tag (#Cons [value #Nil])])) - [tag (` (#Tuple (~ value)))])) + (#Form (#Cons [(#Tag [module name]) (#Cons [value #Nil])])) + [($ text-++ module ";" name) (` (#Tuple (~ value)))])) members)] - (return (list (#Form (list+ (#Tag "Record") (untemplate-list members))))))) + (return (list (#Form (list+ (#Tag ["lux" "TRecord"]) (untemplate-list members))))))) (defmacro (-> tokens) (case' (reverse tokens) @@ -714,43 +721,46 @@ x [y])) (def (replace-ident ident value syntax) - (case' syntax - (#Symbol test) - (if (text= test ident) - value - syntax) - - (#Form members) - (#Form (map (replace-ident ident value) members)) - - (#Tuple members) - (#Tuple (map (replace-ident ident value) members)) - - (#Record members) - (#Record (map (lambda [kv] - (case' kv - [k v] - [k (replace-ident ident value v)])) - members)) - - _ - syntax)) + (let [[module name] ident] + (case' syntax + (#Symbol [?module ?name]) + (if (and (text= module ?module) + (text= name ?name)) + value + syntax) + + (#Form members) + (#Form (map (replace-ident ident value) members)) + + (#Tuple members) + (#Tuple (map (replace-ident ident value) members)) + + (#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 [(#Symbol name) (#Cons [(#Tuple args) (#Cons [body #Nil])])]) + (#Cons [(#Symbol [_ 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 - (#Symbol arg-name) - (` (#All (list) (~ (#Text "")) (~ (#Text arg-name)) (~ (replace-ident arg-name (` (#Bound (~ (#Text arg-name)))) + (#Symbol [arg-module arg-name]) + (` (#All (list) (~ (#Text "")) (~ (#Text arg-name)) (~ (replace-ident [arg-module arg-name] + (` (#Bound (~ (#Text arg-name)))) body)))))) body args)] (case' rolled - (#Form (#Cons [(#Tag "All") (#Cons [env (#Cons [(#Test "") (#Cons [(#Text arg-name) (#Cons [body #Nil])])])])])) + (#Form (#Cons [(#Tag ["lux" "TAll"]) (#Cons [env (#Cons [(#Test "") (#Cons [(#Text arg-name) (#Cons [body #Nil])])])])])) (return (list (` (#All (~ env) (~ (#Text name)) (~ (#Text arg-name)) (~ (replace-ident arg-name (` (#Bound (~ (#Text name)))) body))))))))) @@ -853,7 +863,7 @@ ## (case tokens ## (list+ (#Symbol name) tokens') ## [tokens' [(#Symbol name) (list)]] - + ## (list+ (#Form (list+ (#Symbol name) args)) tokens') ## [tokens' [(#Symbol name) args]])) @@ -882,7 +892,7 @@ ## (defstruct ListMonad (Monad List) ## (def (return x) ## (list x)) - + ## (def bind (. concat map))) ## (defsig (Eq a) diff --git a/src/lux.clj b/src/lux.clj index 9f48294c6..3922a21d8 100644 --- a/src/lux.clj +++ b/src/lux.clj @@ -12,7 +12,6 @@ ;; TODO: Add source-file information to .class files for easier debugging. ;; TODO: Finish implementing class & interface definition ;; TODO: All optimizations - ;; TODO: Take module-name aliasing into account. ;; TODO: ;; Finish total-locals diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index 1497a990f..30f829ee7 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -14,376 +14,378 @@ ;; [Utils] (defn ^:private parse-handler [[catch+ finally+] token] (matchv ::M/objects [token] - [["Form" ["Cons" [["Symbol" "jvm-catch"] - ["Cons" [["Symbol" ?ex-class] - ["Cons" [["Symbol" ?ex-arg] + [["Form" ["Cons" [["Symbol" [_ "jvm-catch"]] + ["Cons" [["Symbol" [_ ?ex-class]] + ["Cons" [["Symbol" [_ ?ex-arg]] ["Cons" [?catch-body ["Nil" _]]]]]]]]]]] [(concat catch+ (list [?ex-class ?ex-arg ?catch-body])) finally+] - [["Form" ["Cons" [["Symbol" "jvm-finally"] + [["Form" ["Cons" [["Symbol" [_ "jvm-finally"]] ["Cons" [?finally-body ["Nil" _]]]]]]] [catch+ ?finally-body])) (defn ^:private analyse-basic-ast [analyse eval! token] + ;; (prn 'analyse-basic-ast (aget token 0)) ;; (prn 'analyse-basic-ast token (&/show-ast token)) (matchv ::M/objects [token] ;; Standard special forms - [["Bool" ?value]] - (return (&/|list (&/V "Expression" (&/T (&/V "bool" ?value) (&/V "Data" (&/T "java.lang.Boolean" (&/V "Nil" nil))))))) + [["lux;Bool" ?value]] + (return (&/|list (&/V "Expression" (&/T (&/V "bool" ?value) (&/V "lux;TData" (&/T "java.lang.Boolean" (&/V "lux;Nil" nil))))))) - [["Int" ?value]] - (return (&/|list (&/V "Expression" (&/T (&/V "int" ?value) (&/V "Data" (&/T "java.lang.Long" (&/V "Nil" nil))))))) + [["lux;Int" ?value]] + (return (&/|list (&/V "Expression" (&/T (&/V "int" ?value) (&/V "lux;TData" (&/T "java.lang.Long" (&/V "lux;Nil" nil))))))) - [["Real" ?value]] - (return (&/|list (&/V "Expression" (&/T (&/V "real" ?value) (&/V "Data" (&/T "java.lang.Double" (&/V "Nil" nil))))))) + [["lux;Real" ?value]] + (return (&/|list (&/V "Expression" (&/T (&/V "real" ?value) (&/V "lux;TData" (&/T "java.lang.Double" (&/V "lux;Nil" nil))))))) - [["Char" ?value]] - (return (&/|list (&/V "Expression" (&/T (&/V "char" ?value) (&/V "Data" (&/T "java.lang.Character" (&/V "Nil" nil))))))) + [["lux;Char" ?value]] + (return (&/|list (&/V "Expression" (&/T (&/V "char" ?value) (&/V "lux;TData" (&/T "java.lang.Character" (&/V "lux;Nil" nil))))))) - [["Text" ?value]] - (return (&/|list (&/V "Expression" (&/T (&/V "text" ?value) (&/V "Data" (&/T "java.lang.String" (&/V "Nil" nil))))))) + [["lux;Text" ?value]] + (return (&/|list (&/V "Expression" (&/T (&/V "text" ?value) (&/V "lux;TData" (&/T "java.lang.String" (&/V "lux;Nil" nil))))))) - [["Tuple" ?elems]] + [["lux;Tuple" ?elems]] (&&lux/analyse-tuple analyse ?elems) - [["Record" ?elems]] + [["lux;Record" ?elems]] (&&lux/analyse-record analyse ?elems) - [["Tag" ?tag]] - (let [tuple-type (&/V "Tuple" (&/V "Nil" nil))] + [["lux;Tag" [?module ?name]]] + (let [tuple-type (&/V "lux;Tuple" (&/V "lux;Nil" nil)) + ?tag (str ?module ";" ?name)] (return (&/|list (&/V "Expression" (&/T (&/V "variant" (&/T ?tag (&/V "Expression" (&/T (&/V "tuple" (&/|list)) tuple-type)))) - (&/V "Variant" (&/V "Cons" (&/T (&/T ?tag tuple-type) (&/V "Nil" nil))))))))) + (&/V "lux;TVariant" (&/V "lux;Cons" (&/T (&/T ?tag tuple-type) (&/V "lux;Nil" nil))))))))) - [["Symbol" "jvm-null"]] - (return (&/|list (&/V "Expression" (&/T (&/V "jvm-null" nil) (&/V "Data" (&/T "null" (&/V "Nil" nil))))))) + [["lux;Symbol" [_ "jvm-null"]]] + (return (&/|list (&/V "Expression" (&/T (&/V "jvm-null" nil) (&/V "lux;TData" (&/T "null" (&/V "lux;Nil" nil))))))) - [["Symbol" ?ident]] + [["lux;Symbol" ?ident]] (&&lux/analyse-ident analyse ?ident) - [["Form" ["Cons" [["Symbol" "case'"] - ["Cons" [?variant ?branches]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "case'"]] + ["lux;Cons" [?variant ?branches]]]]]] (&&lux/analyse-case analyse ?variant ?branches) - [["Form" ["Cons" [["Symbol" "lambda'"] - ["Cons" [["Symbol" ?self] - ["Cons" [["Symbol" ?arg] - ["Cons" [?body - ["Nil" _]]]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "lambda'"]] + ["lux;Cons" [["lux;Symbol" [_ ?self]] + ["lux;Cons" [["lux;Symbol" [_ ?arg]] + ["lux;Cons" [?body + ["lux;Nil" _]]]]]]]]]]] (&&lux/analyse-lambda analyse ?self ?arg ?body) - [["Form" ["Cons" [["Symbol" "get@'"] ["Cons" [["Tag" ?slot] ["Cons" [?record ["Nil" _]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "get@'"]] ["lux;Cons" [["lux;Tag" ?slot] ["lux;Cons" [?record ["lux;Nil" _]]]]]]]]] (&&lux/analyse-get analyse ?slot ?record) - [["Form" ["Cons" [["Symbol" "set@'"] ["Cons" [["Tag" ?slot] ["Cons" [?value ["Cons" [?record ["Nil" _]]]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "set@'"]] ["lux;Cons" [["lux;Tag" ?slot] ["lux;Cons" [?value ["lux;Cons" [?record ["lux;Nil" _]]]]]]]]]]] (&&lux/analyse-set analyse ?slot ?value ?record) - [["Form" ["Cons" [["Symbol" "def'"] ["Cons" [["Symbol" ?name] ["Cons" [?value ["Nil" _]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "def'"]] ["lux;Cons" [["lux;Symbol" [_ ?name]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] (&&lux/analyse-def analyse ?name ?value) - [["Form" ["Cons" [["Symbol" "declare-macro"] ["Cons" [["Symbol" ?ident] ["Nil" _]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "declare-macro"]] ["lux;Cons" [["lux;Symbol" ?ident] ["lux;Nil" _]]]]]]] (&&lux/analyse-declare-macro ?ident) - [["Form" ["Cons" [["Symbol" "import'"] ["Cons" [["Text" ?path] ["Nil" _]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "import'"]] ["lux;Cons" [["lux;Text" ?path] ["lux;Nil" _]]]]]]] (&&lux/analyse-import analyse ?path) - [["Form" ["Cons" [["Symbol" ":"] ["Cons" [?value ["Cons" [?type ["Nil" _]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ ":"]] ["lux;Cons" [?value ["lux;Cons" [?type ["lux;Nil" _]]]]]]]]] (&&lux/analyse-check analyse eval! ?type ?value) - [["Form" ["Cons" [["Symbol" "coerce"] ["Cons" [?type ["Cons" [?value ["Nil" _]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "coerce"]] ["lux;Cons" [?type ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] (&&lux/analyse-coerce analyse eval! ?type ?value) ;; Host special forms - [["Form" ["Cons" [["Symbol" "exec"] ?exprs]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "exec"]] ?exprs]]]] (&&host/analyse-exec analyse ?exprs) ;; Integer arithmetic - [["Form" ["Cons" [["Symbol" "jvm-iadd"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-iadd"]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-iadd analyse ?x ?y) - [["Form" ["Cons" [["Symbol" "jvm-isub"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-isub"]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-isub analyse ?x ?y) - [["Form" ["Cons" [["Symbol" "jvm-imul"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-imul"]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-imul analyse ?x ?y) - [["Form" ["Cons" [["Symbol" "jvm-idiv"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-idiv"]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-idiv analyse ?x ?y) - [["Form" ["Cons" [["Symbol" "jvm-irem"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-irem"]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-irem analyse ?x ?y) - [["Form" ["Cons" [["Symbol" "jvm-ieq"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-ieq"]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-ieq analyse ?x ?y) - [["Form" ["Cons" [["Symbol" "jvm-ilt"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-ilt"]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-ilt analyse ?x ?y) - [["Form" ["Cons" [["Symbol" "jvm-igt"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-igt"]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-igt analyse ?x ?y) ;; Long arithmetic - [["Form" ["Cons" [["Symbol" "jvm-ladd"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-ladd"]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-ladd analyse ?x ?y) - [["Form" ["Cons" [["Symbol" "jvm-lsub"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-lsub"]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-lsub analyse ?x ?y) - [["Form" ["Cons" [["Symbol" "jvm-lmul"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-lmul"]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-lmul analyse ?x ?y) - [["Form" ["Cons" [["Symbol" "jvm-ldiv"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-ldiv"]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-ldiv analyse ?x ?y) - [["Form" ["Cons" [["Symbol" "jvm-lrem"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-lrem"]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-lrem analyse ?x ?y) - [["Form" ["Cons" [["Symbol" "jvm-leq"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-leq"]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-leq analyse ?x ?y) - [["Form" ["Cons" [["Symbol" "jvm-llt"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-llt"]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-llt analyse ?x ?y) - [["Form" ["Cons" [["Symbol" "jvm-lgt"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-lgt"]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-lgt analyse ?x ?y) ;; Float arithmetic - [["Form" ["Cons" [["Symbol" "jvm-fadd"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-fadd"]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-fadd analyse ?x ?y) - [["Form" ["Cons" [["Symbol" "jvm-fsub"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-fsub"]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-fsub analyse ?x ?y) - [["Form" ["Cons" [["Symbol" "jvm-fmul"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-fmul"]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-fmul analyse ?x ?y) - [["Form" ["Cons" [["Symbol" "jvm-fdiv"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-fdiv"]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-fdiv analyse ?x ?y) - [["Form" ["Cons" [["Symbol" "jvm-frem"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-frem"]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-frem analyse ?x ?y) - [["Form" ["Cons" [["Symbol" "jvm-feq"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-feq"]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-feq analyse ?x ?y) - [["Form" ["Cons" [["Symbol" "jvm-flt"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-flt"]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-flt analyse ?x ?y) - [["Form" ["Cons" [["Symbol" "jvm-fgt"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-fgt"]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-fgt analyse ?x ?y) ;; Double arithmetic - [["Form" ["Cons" [["Symbol" "jvm-dadd"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-dadd"]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-dadd analyse ?x ?y) - [["Form" ["Cons" [["Symbol" "jvm-dsub"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-dsub"]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-dsub analyse ?x ?y) - [["Form" ["Cons" [["Symbol" "jvm-dmul"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-dmul"]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-dmul analyse ?x ?y) - [["Form" ["Cons" [["Symbol" "jvm-ddiv"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-ddiv"]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-ddiv analyse ?x ?y) - [["Form" ["Cons" [["Symbol" "jvm-drem"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-drem"]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-drem analyse ?x ?y) - [["Form" ["Cons" [["Symbol" "jvm-deq"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-deq"]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-deq analyse ?x ?y) - [["Form" ["Cons" [["Symbol" "jvm-dlt"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-dlt"]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-dlt analyse ?x ?y) - [["Form" ["Cons" [["Symbol" "jvm-dgt"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-dgt"]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-dgt analyse ?x ?y) ;; Objects - [["Form" ["Cons" [["Symbol" "jvm-null?"] ["Cons" [?object ["Nil" _]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-null?"]] ["lux;Cons" [?object ["lux;Nil" _]]]]]]] (&&host/analyse-jvm-null? analyse ?object) - [["Form" ["Cons" [["Symbol" "jvm-new"] - ["Cons" [["Symbol" ?class] - ["Cons" [["Tuple" ?classes] - ["Cons" [["Tuple" ?args] - ["Nil" _]]]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-new"]] + ["lux;Cons" [["lux;Symbol" [_ ?class]] + ["lux;Cons" [["lux;Tuple" ?classes] + ["lux;Cons" [["lux;Tuple" ?args] + ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-new analyse ?class ?classes ?args) - [["Form" ["Cons" [["Symbol" "jvm-getstatic"] - ["Cons" [["Symbol" ?class] - ["Cons" [["Text" ?field] - ["Nil" _]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-getstatic"]] + ["lux;Cons" [["lux;Symbol" [_ ?class]] + ["lux;Cons" [["lux;Text" ?field] + ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-getstatic analyse ?class ?field) - [["Form" ["Cons" [["Symbol" "jvm-getfield"] - ["Cons" [["Symbol" ?class] - ["Cons" [["Text" ?field] - ["Cons" [?object - ["Nil" _]]]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-getfield"]] + ["lux;Cons" [["lux;Symbol" [_ ?class]] + ["lux;Cons" [["lux;Text" ?field] + ["lux;Cons" [?object + ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-getfield analyse ?class ?field ?object) - [["Form" ["Cons" [["Symbol" "jvm-putstatic"] - ["Cons" [["Symbol" ?class] - ["Cons" [["Text" ?field] - ["Cons" [?value - ["Nil" _]]]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-putstatic"]] + ["lux;Cons" [["lux;Symbol" [_ ?class]] + ["lux;Cons" [["lux;Text" ?field] + ["lux;Cons" [?value + ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-putstatic analyse ?class ?field ?value) - [["Form" ["Cons" [["Symbol" "jvm-putfield"] - ["Cons" [["Symbol" ?class] - ["Cons" [["Text" ?field] - ["Cons" [?object - ["Cons" [?value - ["Nil" _]]]]]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-putfield"]] + ["lux;Cons" [["lux;Symbol" [_ ?class]] + ["lux;Cons" [["lux;Text" ?field] + ["lux;Cons" [?object + ["lux;Cons" [?value + ["lux;Nil" _]]]]]]]]]]]]] (&&host/analyse-jvm-putfield analyse ?class ?field ?object ?value) - [["Form" ["Cons" [["Symbol" "jvm-invokestatic"] - ["Cons" [["Symbol" ?class] - ["Cons" [["Text" ?method] - ["Cons" [["Tuple" ?classes] - ["Cons" [["Tuple" ?args] - ["Nil" _]]]]]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-invokestatic"]] + ["lux;Cons" [["lux;Symbol" [_ ?class]] + ["lux;Cons" [["lux;Text" ?method] + ["lux;Cons" [["lux;Tuple" ?classes] + ["lux;Cons" [["lux;Tuple" ?args] + ["lux;Nil" _]]]]]]]]]]]]] (&&host/analyse-jvm-invokestatic analyse ?class ?method ?classes ?args) - [["Form" ["Cons" [["Symbol" "jvm-invokevirtual"] - ["Cons" [["Symbol" ?class] - ["Cons" [["Text" ?method] - ["Cons" [["Tuple" ?classes] - ["Cons" [?object - ["Cons" [["Tuple" ?args] - ["Nil" _]]]]]]]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-invokevirtual"]] + ["lux;Cons" [["lux;Symbol" [_ ?class]] + ["lux;Cons" [["lux;Text" ?method] + ["lux;Cons" [["lux;Tuple" ?classes] + ["lux;Cons" [?object + ["lux;Cons" [["lux;Tuple" ?args] + ["lux;Nil" _]]]]]]]]]]]]]]] (&&host/analyse-jvm-invokevirtual analyse ?class ?method ?classes ?object ?args) - [["Form" ["Cons" [["Symbol" "jvm-invokeinterface"] - ["Cons" [["Symbol" ?class] - ["Cons" [["Text" ?method] - ["Cons" [["Tuple" ?classes] - ["Cons" [?object - ["Cons" [["Tuple" ?args] - ["Nil" _]]]]]]]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-invokeinterface"]] + ["lux;Cons" [["lux;Symbol" [_ ?class]] + ["lux;Cons" [["lux;Text" ?method] + ["lux;Cons" [["lux;Tuple" ?classes] + ["lux;Cons" [?object + ["lux;Cons" [["lux;Tuple" ?args] + ["lux;Nil" _]]]]]]]]]]]]]]] (&&host/analyse-jvm-invokeinterface analyse ?class ?method ?classes ?object ?args) - [["Form" ["Cons" [["Symbol" "jvm-invokespecial"] - ["Cons" [["Symbol" ?class] - ["Cons" [["Text" ?method] - ["Cons" [["Tuple" ?classes] - ["Cons" [?object - ["Cons" [["Tuple" ?args] - ["Nil" _]]]]]]]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-invokespecial"]] + ["lux;Cons" [["lux;Symbol" [_ ?class]] + ["lux;Cons" [["lux;Text" ?method] + ["lux;Cons" [["lux;Tuple" ?classes] + ["lux;Cons" [?object + ["lux;Cons" [["lux;Tuple" ?args] + ["lux;Nil" _]]]]]]]]]]]]]]] (&&host/analyse-jvm-invokespecial analyse ?class ?method ?classes ?object ?args) ;; Exceptions - [["Form" ["Cons" [["Symbol" "jvm-try"] - ["Cons" [?body - ?handlers]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-try"]] + ["lux;Cons" [?body + ?handlers]]]]]] (&&host/analyse-jvm-try analyse ?body (&/fold parse-handler [(list) nil] ?handlers)) - [["Form" ["Cons" [["Symbol" "jvm-throw"] - ["Cons" [?ex - ["Nil" _]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-throw"]] + ["lux;Cons" [?ex + ["lux;Nil" _]]]]]]] (&&host/analyse-jvm-throw analyse ?ex) ;; Syncronization/monitos - [["Form" ["Cons" [["Symbol" "jvm-monitorenter"] - ["Cons" [?monitor - ["Nil" _]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-monitorenter"]] + ["lux;Cons" [?monitor + ["lux;Nil" _]]]]]]] (&&host/analyse-jvm-monitorenter analyse ?monitor) - [["Form" ["Cons" [["Symbol" "jvm-monitorexit"] - ["Cons" [?monitor - ["Nil" _]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-monitorexit"]] + ["lux;Cons" [?monitor + ["lux;Nil" _]]]]]]] (&&host/analyse-jvm-monitorexit analyse ?monitor) ;; Primitive conversions - [["Form" ["Cons" [["Symbol" "jvm-d2f"] ["Cons" [?value ["Nil" _]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-d2f"]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] (&&host/analyse-jvm-d2f analyse ?value) - [["Form" ["Cons" [["Symbol" "jvm-d2i"] ["Cons" [?value ["Nil" _]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-d2i"]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] (&&host/analyse-jvm-d2i analyse ?value) - [["Form" ["Cons" [["Symbol" "jvm-d2l"] ["Cons" [?value ["Nil" _]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-d2l"]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] (&&host/analyse-jvm-d2l analyse ?value) - [["Form" ["Cons" [["Symbol" "jvm-f2d"] ["Cons" [?value ["Nil" _]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-f2d"]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] (&&host/analyse-jvm-f2d analyse ?value) - [["Form" ["Cons" [["Symbol" "jvm-f2i"] ["Cons" [?value ["Nil" _]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-f2i"]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] (&&host/analyse-jvm-f2i analyse ?value) - [["Form" ["Cons" [["Symbol" "jvm-f2l"] ["Cons" [?value ["Nil" _]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-f2l"]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] (&&host/analyse-jvm-f2l analyse ?value) - [["Form" ["Cons" [["Symbol" "jvm-i2b"] ["Cons" [?value ["Nil" _]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-i2b"]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] (&&host/analyse-jvm-i2b analyse ?value) - [["Form" ["Cons" [["Symbol" "jvm-i2c"] ["Cons" [?value ["Nil" _]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-i2c"]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] (&&host/analyse-jvm-i2c analyse ?value) - [["Form" ["Cons" [["Symbol" "jvm-i2d"] ["Cons" [?value ["Nil" _]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-i2d"]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] (&&host/analyse-jvm-i2d analyse ?value) - [["Form" ["Cons" [["Symbol" "jvm-i2f"] ["Cons" [?value ["Nil" _]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-i2f"]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] (&&host/analyse-jvm-i2f analyse ?value) - [["Form" ["Cons" [["Symbol" "jvm-i2l"] ["Cons" [?value ["Nil" _]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-i2l"]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] (&&host/analyse-jvm-i2l analyse ?value) - [["Form" ["Cons" [["Symbol" "jvm-i2s"] ["Cons" [?value ["Nil" _]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-i2s"]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] (&&host/analyse-jvm-i2s analyse ?value) - [["Form" ["Cons" [["Symbol" "jvm-l2d"] ["Cons" [?value ["Nil" _]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-l2d"]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] (&&host/analyse-jvm-l2d analyse ?value) - [["Form" ["Cons" [["Symbol" "jvm-l2f"] ["Cons" [?value ["Nil" _]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-l2f"]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] (&&host/analyse-jvm-l2f analyse ?value) - [["Form" ["Cons" [["Symbol" "jvm-l2i"] ["Cons" [?value ["Nil" _]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-l2i"]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]] (&&host/analyse-jvm-l2i analyse ?value) ;; Bitwise operators - [["Form" ["Cons" [["Symbol" "jvm-iand"] ["Cons" [?x ["Cons" [?y ["Nil" _]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-iand"]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-iand analyse ?x ?y) - [["Form" ["Cons" [["Symbol" "jvm-ior"] ["Cons" [?x ["Cons" [?y ["Nil" _]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-ior"]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-ior analyse ?x ?y) - [["Form" ["Cons" [["Symbol" "jvm-land"] ["Cons" [?x ["Cons" [?y ["Nil" _]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-land"]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-land analyse ?x ?y) - [["Form" ["Cons" [["Symbol" "jvm-lor"] ["Cons" [?x ["Cons" [?y ["Nil" _]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-lor"]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-lor analyse ?x ?y) - [["Form" ["Cons" [["Symbol" "jvm-lxor"] ["Cons" [?x ["Cons" [?y ["Nil" _]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-lxor"]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-lxor analyse ?x ?y) - [["Form" ["Cons" [["Symbol" "jvm-lshl"] ["Cons" [?x ["Cons" [?y ["Nil" _]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-lshl"]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-lshl analyse ?x ?y) - [["Form" ["Cons" [["Symbol" "jvm-lshr"] ["Cons" [?x ["Cons" [?y ["Nil" _]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-lshr"]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-lshr analyse ?x ?y) - [["Form" ["Cons" [["Symbol" "jvm-lushr"] ["Cons" [?x ["Cons" [?y ["Nil" _]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-lushr"]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-lushr analyse ?x ?y) ;; Arrays - [["Form" ["Cons" [["Symbol" "jvm-new-array"] ["Cons" [["Symbol" ?class] ["Cons" [["Int" ?length] ["Nil" _]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-new-array"]] ["lux;Cons" [["lux;Symbol" [_ ?class]] ["lux;Cons" [["lux;Int" ?length] ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-new-array analyse ?class ?length) - [["Form" ["Cons" [["Symbol" "jvm-aastore"] ["Cons" [?array ["Cons" [["Int" ?idx] ["Cons" [?elem ["Nil" _]]]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-aastore"]] ["lux;Cons" [?array ["lux;Cons" [["lux;Int" ?idx] ["lux;Cons" [?elem ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-aastore analyse ?array ?idx ?elem) - [["Form" ["Cons" [["Symbol" "jvm-aaload"] ["Cons" [?array ["Cons" [["Int" ?idx] ["Nil" _]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-aaload"]] ["lux;Cons" [?array ["lux;Cons" [["lux;Int" ?idx] ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-aaload analyse ?array ?idx) ;; Classes & interfaces - [["Form" ["Cons" [["Symbol" "jvm-class"] ["Cons" [["Symbol" ?name] ["Cons" [["Symbol" ?super-class] ["Cons" [["Tuple" ?fields] ["Nil" _]]]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-class"]] ["lux;Cons" [["lux;Symbol" [_ ?name]] ["lux;Cons" [["lux;Symbol" [_ ?super-class]] ["lux;Cons" [["lux;Tuple" ?fields] ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-class analyse ?name ?super-class ?fields) - [["Form" ["Cons" [["Symbol" "jvm-interface"] ["Cons" [["Symbol" ?name] ?members]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-interface"]] ["lux;Cons" [["lux;Symbol" [_ ?name]] ?members]]]]]] (&&host/analyse-jvm-interface analyse ?name ?members) ;; Programs - [["Form" ["Cons" [["Symbol" "jvm-program"] ["Cons" [["Symbol" ?args] ["Cons" [?body ["Nil" _]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "jvm-program"]] ["lux;Cons" [["lux;Symbol" [_ ?args]] ["lux;Cons" [?body ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-program analyse ?args ?body) [_] @@ -393,24 +395,25 @@ (fn [token] ;; (prn 'analyse-ast token) (matchv ::M/objects [token] - [["Form" ["Cons" [["Tag" ?tag] ?values]]]] + [["lux;Form" ["lux;Cons" [["lux;Tag" [?module ?name]] ?values]]]] (exec [;; :let [_ (prn 'PRE-ASSERT)] + :let [?tag (str ?module ";" ?name)] :let [_ (assert (= 1 (&/|length ?values)) (str "[Analyser Error] Can only tag 1 value: " (pr-str token)))] ;; :let [_ (prn 'POST-ASSERT)] =value (&&/analyse-1 (analyse-ast eval!) (&/|head ?values)) =value-type (&&/expr-type =value)] - (return (&/|list (&/V "Expression" (&/T (&/V "variant" (&/T ?tag =value)) (&/V "Variant" (&/V "Cons" (&/T (&/T ?tag =value-type) (&/V "Nil" nil))))))))) + (return (&/|list (&/V "Expression" (&/T (&/V "variant" (&/T ?tag =value)) (&/V "lux;TVariant" (&/V "lux;Cons" (&/T (&/T ?tag =value-type) (&/V "lux;Nil" nil))))))))) - [["Form" ["Cons" [?fn ?args]]]] + [["lux;Form" ["lux;Cons" [?fn ?args]]]] (fn [state] ;; (prn '(&/show-ast ?fn) (&/show-ast ?fn)) (matchv ::M/objects [((&&/analyse-1 (analyse-ast eval!) ?fn) state)] - [["Right" [state* =fn]]] + [["lux;Right" [state* =fn]]] ((&&lux/analyse-apply (analyse-ast eval!) =fn ?args) state*) [_] (do ;; (prn 'analyse-ast/token (aget token 0) (&/show-state state)) - ((analyse-basic-ast (analyse-ast eval!) eval! token) state)))) + ((analyse-basic-ast (analyse-ast eval!) eval! token) state)))) [_] (analyse-basic-ast (analyse-ast eval!) eval! token)))) diff --git a/src/lux/analyser/base.clj b/src/lux/analyser/base.clj index f67b7e281..827d0336e 100644 --- a/src/lux/analyser/base.clj +++ b/src/lux/analyser/base.clj @@ -20,7 +20,7 @@ (exec [output (analyse elem)] (do ;; (prn 'analyse-1 (aget output 0)) (matchv ::M/objects [output] - [["Cons" [x ["Nil" _]]]] + [["lux;Cons" [x ["lux;Nil" _]]]] (return x) [_] @@ -30,7 +30,7 @@ (exec [output (&/flat-map% analyse (&/|list el1 el2))] (do ;; (prn 'analyse-2 (aget output 0)) (matchv ::M/objects [output] - [["Cons" [x ["Cons" [y ["Nil" _]]]]]] + [["lux;Cons" [x ["lux;Cons" [y ["lux;Nil" _]]]]]] (return [x y]) [_] diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj index db96dbf2f..38ec41e64 100644 --- a/src/lux/analyser/case.clj +++ b/src/lux/analyser/case.clj @@ -10,13 +10,13 @@ ;; [Resources] (defn locals [member] (matchv ::M/objects [member] - [["Symbol" ?name]] + [["lux;Symbol" [_ ?name]]] (&/|list ?name) - [["Tuple" ?submembers]] + [["lux;Tuple" ?submembers]] (&/flat-map locals ?submembers) - [["Form" ["Cons" [["Tag" _] ?submembers]]]] + [["lux;Form" ["lux;Cons" [["lux;Tag" _] ?submembers]]]] (&/flat-map locals ?submembers) [_] @@ -24,7 +24,7 @@ (defn analyse-branch [analyse max-registers bindings+body] (|let [[bindings body] bindings+body] - (do ;; (prn 'analyse-branch max-registers (&/|length bindings) body) + (do ;; (prn 'analyse-branch max-registers (&/->seq bindings) body) (&/fold (fn [body* name] (&&/with-var (fn [=var] diff --git a/src/lux/analyser/def.clj b/src/lux/analyser/def.clj index 45bb5aca7..2a9b181e2 100644 --- a/src/lux/analyser/def.clj +++ b/src/lux/analyser/def.clj @@ -7,22 +7,22 @@ ;; [Exports] (def init-module - (&/R "defs" (&/|table) - "macros" (&/|table))) + (&/R "lux;defs" (&/|table) + "lux;macros" (&/|table))) (do-template [ ] (defn [module name] (fn [state] (return* state - (->> state (&/get$ "modules") (&/|get module) (&/get$ ) (&/|contains? name))))) + (->> state (&/get$ "lux;modules") (&/|get module) (&/get$ ) (&/|contains? name))))) - defined? "defs" - macro? "macros" + defined? "lux;defs" + macro? "lux;macros" ) (defn declare-macro [module name] (fn [state] - (return* (&/update$ "modules" (fn [ms] (&/|update module (fn [m] (&/update$ "macros" #(&/|put name true %) m)) ms)) state) + (return* (&/update$ "lux;modules" (fn [ms] (&/|update module (fn [m] (&/update$ "lux;macros" #(&/|put name true %) m)) ms)) state) nil))) (defn define [module name type] @@ -30,17 +30,28 @@ (let [full-name (str module &/+name-separator+ name) bound (&/V "Expression" (&/T (&/V "global" (&/T module name)) type))] (return* (->> state - (&/update$ "modules" (fn [ms] (&/|update module (fn [m] (&/update$ "defs" #(&/|put name type %) m)) ms))) - (&/update$ "global-env" #(matchv ::M/objects [%] - [["None" _]] - (assert false) - - [["Some" table]] - (&/V "Some" (&/update$ "locals" (fn [locals] - (&/update$ "mappings" (fn [mappings] - (&/|merge (&/|table full-name bound, name bound) - mappings)) - locals)) - table)) - ))) + (&/update$ "lux;modules" (fn [ms] (&/|update module (fn [m] (&/update$ "lux;defs" #(&/|put name type %) m)) ms))) + (&/update$ "lux;global-env" #(matchv ::M/objects [%] + [["lux;None" _]] + (assert false) + + [["lux;Some" table]] + (&/V "lux;Some" (&/update$ "lux;locals" (fn [locals] + (&/update$ "lux;mappings" (fn [mappings] + (&/|merge (&/|table full-name bound, name bound) + mappings)) + locals)) + table)) + ))) nil)))) + +(defn module-exists? [name] + (fn [state] + (return* state + (->> state (&/get$ "lux;modules") (&/|contains? name))))) + +(defn unalias-module [name] + (fn [state] + (if-let [real-name (->> state (&/get$ "lux;module-aliases") (&/|get name))] + (return* state real-name) + (fail "Unknown alias.")))) diff --git a/src/lux/analyser/env.clj b/src/lux/analyser/env.clj index 4d1af9aa9..4f772e126 100644 --- a/src/lux/analyser/env.clj +++ b/src/lux/analyser/env.clj @@ -7,26 +7,26 @@ ;; [Exports] (def next-local-idx (fn [state] - (return* state (->> state (&/get$ "local-envs") &/|head (&/get$ "locals") (&/get$ "counter"))))) + (return* state (->> state (&/get$ "lux;local-envs") &/|head (&/get$ "lux;locals") (&/get$ "lux;counter"))))) (defn with-local [name type body] (fn [state] - (let [old-mappings (->> state (&/get$ "local-envs") &/|head (&/get$ "locals") (&/get$ "mappings")) - =return (body (&/update$ "local-envs" + (let [old-mappings (->> state (&/get$ "lux;local-envs") &/|head (&/get$ "lux;locals") (&/get$ "lux;mappings")) + =return (body (&/update$ "lux;local-envs" (fn [stack] - (let [bound-unit (&/V "local" (->> (&/|head stack) (&/get$ "locals") (&/get$ "counter")))] + (let [bound-unit (&/V "local" (->> (&/|head stack) (&/get$ "lux;locals") (&/get$ "lux;counter")))] (&/|cons (->> (&/|head stack) - (&/update$ "locals" #(&/update$ "counter" inc %)) - (&/update$ "locals" #(&/update$ "mappings" (fn [m] (&/|put name (&/V "Expression" (&/T bound-unit type)) m)) %))) + (&/update$ "lux;locals" #(&/update$ "lux;counter" inc %)) + (&/update$ "lux;locals" #(&/update$ "lux;mappings" (fn [m] (&/|put name (&/V "Expression" (&/T bound-unit type)) m)) %))) (&/|tail stack)))) state))] (matchv ::M/objects [=return] - [["Right" [?state ?value]]] - (return* (&/update$ "local-envs" (fn [stack*] - (&/|cons (->> (&/|head stack*) - (&/update$ "locals" #(&/update$ "counter" dec %)) - (&/update$ "locals" #(&/set$ "mappings" old-mappings %))) - (&/|tail stack*))) + [["lux;Right" [?state ?value]]] + (return* (&/update$ "lux;local-envs" (fn [stack*] + (&/|cons (->> (&/|head stack*) + (&/update$ "lux;locals" #(&/update$ "lux;counter" dec %)) + (&/update$ "lux;locals" #(&/set$ "lux;mappings" old-mappings %))) + (&/|tail stack*))) ?state) ?value) @@ -41,4 +41,4 @@ (def captured-vars (fn [state] - (return* state (->> state (&/get$ "local-envs") &/|head (&/get$ "closure") (&/get$ "mappings"))))) + (return* state (->> state (&/get$ "lux;local-envs") &/|head (&/get$ "lux;closure") (&/get$ "lux;mappings"))))) diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj index 34d3fa1bc..999c5df8a 100644 --- a/src/lux/analyser/host.clj +++ b/src/lux/analyser/host.clj @@ -12,7 +12,7 @@ ;; [Utils] (defn ^:private extract-ident [ident] (matchv ::M/objects [ident] - [["Symbol" ?ident]] + [["lux;Symbol" [_ ?ident]]] (return ?ident) [_] @@ -20,8 +20,8 @@ ;; [Resources] (do-template [ ] - (let [input-type (&/V "Data" (to-array [ (&/V "Nil" nil)])) - output-type (&/V "Data" (to-array [ (&/V "Nil" nil)]))] + (let [input-type (&/V "lux;TData" (to-array [ (&/V "lux;Nil" nil)])) + output-type (&/V "lux;TData" (to-array [ (&/V "lux;Nil" nil)]))] (defn [analyse ?x ?y] (exec [[=x =y] (&&/analyse-2 analyse ?x ?y) =x-type (&&/expr-type =x) @@ -105,6 +105,7 @@ (do-template [ ] (defn [analyse ?class ?method ?classes ?object ?args] + ;; (prn ' ?class ?method) (exec [=class (&host/full-class-name ?class) ;; :let [_ (prn 'analyse-jvm-invokevirtual/=class =class)] =classes (&/map% &host/extract-jvm-param ?classes) @@ -125,18 +126,18 @@ (defn analyse-jvm-null? [analyse ?object] (exec [=object (&&/analyse-1 analyse ?object)] - (return (&/|list (&/V "Expression" (&/T (&/V "jvm-null?" =object) (&/V "Data" (&/T "java.lang.Boolean" (&/V "Nil" nil))))))))) + (return (&/|list (&/V "Expression" (&/T (&/V "jvm-null?" =object) (&/V "lux;TData" (&/T "java.lang.Boolean" (&/V "lux;Nil" nil))))))))) (defn analyse-jvm-new [analyse ?class ?classes ?args] (exec [=class (&host/full-class-name ?class) =classes (&/map% &host/extract-jvm-param ?classes) =args (&/flat-map% analyse ?args)] - (return (&/|list (&/V "Expression" (&/T (&/V "jvm-new" (&/T =class =classes =args)) (&/V "Data" (&/T =class (&/V "Nil" nil))))))))) + (return (&/|list (&/V "Expression" (&/T (&/V "jvm-new" (&/T =class =classes =args)) (&/V "lux;TData" (&/T =class (&/V "lux;Nil" nil))))))))) (defn analyse-jvm-new-array [analyse ?class ?length] (exec [=class (&host/full-class-name ?class)] - (return (&/|list (&/V "Expression" (&/T (&/V "jvm-new-array" (&/T =class ?length)) (&/V "array" (&/T (&/V "Data" (to-array [=class (&/V "Nil" nil)])) - (&/V "Nil" nil))))))))) + (return (&/|list (&/V "Expression" (&/T (&/V "jvm-new-array" (&/T =class ?length)) (&/V "array" (&/T (&/V "lux;TData" (to-array [=class (&/V "lux;Nil" nil)])) + (&/V "lux;Nil" nil))))))))) (defn analyse-jvm-aastore [analyse ?array ?idx ?elem] (exec [=array+=elem (&&/analyse-2 analyse ?array ?elem) @@ -154,7 +155,7 @@ (defn analyse-jvm-class [analyse ?name ?super-class ?fields] (exec [?fields (&/map% (fn [?field] (matchv ::M/objects [?field] - [["Tuple" ["Cons" [["Symbol" ?class] ["Cons" [["Symbol" ?field-name] ["Nil" _]]]]]]] + [["lux;Tuple" ["lux;Cons" [["lux;Symbol" ?class] ["lux;Cons" [["lux;Symbol" ?field-name] ["lux;Nil" _]]]]]]] (return [?class ?field-name]) [_] @@ -171,13 +172,13 @@ (exec [=members (&/map% (fn [member] ;; (prn 'analyse-jvm-interface (&/show-ast member)) (matchv ::M/objects [member] - [["Form" ["Cons" [["Symbol" ":"] - ["Cons" [["Symbol" ?member-name] - ["Cons" [["Form" ["Cons" [["Symbol" "->"] - ["Cons" [["Tuple" ?inputs] - ["Cons" [["Symbol" ?output] - ["Nil" _]]]]]]]] - ["Nil" _]]]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ ":"]] + ["lux;Cons" [["lux;Symbol" [_ ?member-name]] + ["lux;Cons" [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "->"]] + ["lux;Cons" [["lux;Tuple" ?inputs] + ["lux;Cons" [["lux;Symbol" [_ ?output]] + ["lux;Nil" _]]]]]]]] + ["lux;Nil" _]]]]]]]]] (do ;; (prn 'analyse-jvm-interface ?member-name ?inputs ?output) (exec [?inputs (&/map% extract-ident ?inputs)] (return [?member-name [?inputs ?output]]))) @@ -201,7 +202,7 @@ (defn analyse-jvm-try [analyse ?body [?catches ?finally]] (exec [=body (&&/analyse-1 analyse ?body) =catches (&/map% (fn [[?ex-class ?ex-arg ?catch-body]] - (&&env/with-local ?ex-arg (&/V "Data" (&/T ?ex-class (&/V "Nil" nil))) + (&&env/with-local ?ex-arg (&/V "lux;TData" (&/T ?ex-class (&/V "lux;Nil" nil))) (exec [=catch-body (&&/analyse-1 analyse ?catch-body)] (return [?ex-class ?ex-arg =catch-body])))) ?catches) @@ -211,20 +212,20 @@ (defn analyse-jvm-throw [analyse ?ex] (exec [=ex (&&/analyse-1 analyse ?ex)] - (return (&/|list (&/V "Expression" (&/T (&/V "jvm-throw" =ex) (&/V "Nothing" nil))))))) + (return (&/|list (&/V "Expression" (&/T (&/V "jvm-throw" =ex) (&/V "lux;TNothing" nil))))))) (defn analyse-jvm-monitorenter [analyse ?monitor] (exec [=monitor (&&/analyse-1 analyse ?monitor)] - (return (&/|list (&/V "Expression" (&/T (&/V "jvm-monitorenter" =monitor) (&/V "Tuple" (&/V "Nil" nil)))))))) + (return (&/|list (&/V "Expression" (&/T (&/V "jvm-monitorenter" =monitor) (&/V "lux;TTuple" (&/V "lux;Nil" nil)))))))) (defn analyse-jvm-monitorexit [analyse ?monitor] (exec [=monitor (&&/analyse-1 analyse ?monitor)] - (return (&/|list (&/V "Expression" (&/T (&/V "jvm-monitorexit" =monitor) (&/V "Tuple" (&/V "Nil" nil)))))))) + (return (&/|list (&/V "Expression" (&/T (&/V "jvm-monitorexit" =monitor) (&/V "lux;TTuple" (&/V "lux;Nil" nil)))))))) (do-template [ ] (defn [analyse ?value] (exec [=value (&&/analyse-1 analyse ?value)] - (return (&/|list (&/V "Expression" (&/T (&/V =value) (&/V "Data" (&/T (&/V "Nil" nil))))))))) + (return (&/|list (&/V "Expression" (&/T (&/V =value) (&/V "lux;TData" (&/T (&/V "lux;Nil" nil))))))))) analyse-jvm-d2f "jvm-d2f" "java.lang.Double" "java.lang.Float" analyse-jvm-d2i "jvm-d2i" "java.lang.Double" "java.lang.Integer" @@ -249,7 +250,7 @@ (do-template [ ] (defn [analyse ?value] (exec [=value (&&/analyse-1 analyse ?value)] - (return (&/|list (&/V "Expression" (&/T (&/V =value) (&/V "Data" (&/T (&/V "Nil" nil))))))))) + (return (&/|list (&/V "Expression" (&/T (&/V =value) (&/V "lux;TData" (&/T (&/V "lux;Nil" nil))))))))) analyse-jvm-iand "jvm-iand" "java.lang.Integer" "java.lang.Integer" analyse-jvm-ior "jvm-ior" "java.lang.Integer" "java.lang.Integer" @@ -264,6 +265,6 @@ ) (defn analyse-jvm-program [analyse ?args ?body] - (exec [=body (&&env/with-local ?args (&/V "Any" nil) + (exec [=body (&&env/with-local ?args (&/V "lux;TAny" nil) (&&/analyse-1 analyse ?body))] (return (&/|list (&/V "Statement" (&/V "jvm-program" =body)))))) diff --git a/src/lux/analyser/lambda.clj b/src/lux/analyser/lambda.clj index 758d0bb6b..c4d218c18 100644 --- a/src/lux/analyser/lambda.clj +++ b/src/lux/analyser/lambda.clj @@ -16,10 +16,11 @@ (return (&/T scope-name =captured =return)))))))) (defn close-over [scope ident register frame] + ;; (prn 'close-over scope ident register frame) (matchv ::M/objects [register] [["Expression" [_ register-type]]] - (let [register* (&/V "Expression" (&/T (&/V "captured" (&/T scope (->> frame (&/get$ "closure") (&/get$ "counter")) register)) register-type))] - (&/T register* (&/update$ "closure" #(->> % - (&/update$ "counter" inc) - (&/update$ "mappings" (fn [mps] (&/|put ident register* mps)))) + (let [register* (&/V "Expression" (&/T (&/V "captured" (&/T scope (->> frame (&/get$ "lux;closure") (&/get$ "lux;counter")) register)) register-type))] + (&/T register* (&/update$ "lux;closure" #(->> % + (&/update$ "lux;counter" inc) + (&/update$ "lux;mappings" (fn [mps] (&/|put ident register* mps)))) frame))))) diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index d30096ab1..f8555f9d1 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -19,7 +19,7 @@ =elems-types (&/map% &&/expr-type =elems) ;; :let [_ (prn 'analyse-tuple =elems)] ] - (return (&/|list (&/V "Expression" (&/T (&/V "tuple" =elems) (&/V "Tuple" =elems-types))))))) + (return (&/|list (&/V "Expression" (&/T (&/V "tuple" =elems) (&/V "lux;TTuple" =elems-types))))))) (defn analyse-record [analyse ?elems] (exec [=elems (&/map% (fn [kv] @@ -36,56 +36,66 @@ =elems) ;; :let [_ (prn 'analyse-tuple =elems)] ] - (return (&/|list (&/V "Expression" (&/T (&/V "record" =elems) (&/V "Record" =elems-types))))))) + (return (&/|list (&/V "Expression" (&/T (&/V "lux;record" =elems) (&/V "lux;TRecord" =elems-types))))))) (defn ^:private resolve-global [ident state] - (if-let [global (->> state (&/get$ "global-env") &/from-some (&/get$ "locals") (&/get$ "mappings") (&/|get ident))] - (return* state (&/|list global)) - (fail* (str "[Analyser Error] Unresolved identifier: " ident)))) + (|let [[?module ?name] ident + ident* (str ?module ";" ?name)] + (if-let [global (->> state (&/get$ "lux;global-env") &/from-some (&/get$ "lux;locals") (&/get$ "lux;mappings") (&/|get ident*))] + (return* state (&/|list global)) + (fail* (str "[Analyser Error] Unresolved identifier: " ident*))))) (defn analyse-ident [analyse ident] ;; (prn 'analyse-ident ident) - (exec [module-name &/get-module-name] - (fn [state] - ;; (prn 'module-name module-name) - ;; (prn '(&/get$ "local-envs" state) (&/get$ "local-envs" state)) - ;; (prn '(&/->seq (&/get$ "local-envs" state)) (&/->seq (&/get$ "local-envs" state))) - ;; (println (&/show-state state)) - (let [stack (&/get$ "local-envs" state)] - (matchv ::M/objects [stack] - [["Nil" _]] - (resolve-global ident state) - - [["Cons" [top stack*]]] - (if-let [=bound (or (->> stack &/|head (&/get$ "locals") (&/get$ "mappings") (&/|get ident)) - (->> stack &/|head (&/get$ "closure") (&/get$ "mappings") (&/|get ident)))] - (return* state (&/|list =bound)) - (|let [no-binding? #(and (->> % (&/get$ "locals") (&/get$ "mappings") (&/|contains? ident) not) - (->> % (&/get$ "closure") (&/get$ "mappings") (&/|contains? ident) not)) - [inner outer] (&/|split-with no-binding? stack*)] - (matchv ::M/objects [outer] - [["Nil" _]] + (|let [[?module ?name] ident] + (do ;; (prn 'analyse-ident ?module ?name) + (exec [module-name &/get-module-name] + (if (not= module-name ?module) + (partial resolve-global ident) + (fn [state] + ;; (when (and (= "lux" ?module) + ;; (= "output" ?name)) + ;; (prn (&/show-state state))) + ;; (prn 'module-name module-name) + ;; (prn '(&/get$ "local-envs" state) (&/get$ "local-envs" state)) + ;; (prn '(&/->seq (&/get$ "local-envs" state)) (&/->seq (&/get$ "local-envs" state))) + ;; (println (&/show-state state)) + (let [stack (&/get$ "lux;local-envs" state)] + (matchv ::M/objects [stack] + [["lux;Nil" _]] (resolve-global ident state) - - [["Cons" [top-outer _]]] - (let [in-stack (&/|cons top inner) - scopes (&/|tail (&/folds #(&/|cons (&/get$ "name" %2) %1) - (&/|map #(&/get$ "name" %) outer) - (&/|reverse in-stack))) - ;; _ (prn 'in-stack module-name ident (&/->seq (&/|map #(&/get$ "name" %) in-stack)) scopes) - [=local inner*] (&/fold (fn [register+new-inner frame+in-scope] - (|let [[register new-inner] register+new-inner - [frame in-scope] frame+in-scope - [register* frame*] (&&lambda/close-over (&/|cons module-name (&/|reverse in-scope)) ident register frame)] - (&/T register* (&/|cons frame* new-inner)))) - (&/T (or (->> top-outer (&/get$ "locals") (&/get$ "mappings") (&/|get ident)) - (->> top-outer (&/get$ "closure") (&/get$ "mappings") (&/|get ident))) - (&/|list)) - (&/zip2 (&/|reverse in-stack) scopes))] - (return* (&/set$ "local-envs" (&/|++ inner* outer) state) (&/|list =local))) - ))) - )) - ))) + + [["lux;Cons" [top stack*]]] + (if-let [=bound (or (->> stack &/|head (&/get$ "lux;locals") (&/get$ "lux;mappings") (&/|get ?name)) + (->> stack &/|head (&/get$ "lux;closure") (&/get$ "lux;mappings") (&/|get ?name)))] + (return* state (&/|list =bound)) + (|let [no-binding? #(and (->> % (&/get$ "lux;locals") (&/get$ "lux;mappings") (&/|contains? ?name) not) + (->> % (&/get$ "lux;closure") (&/get$ "lux;mappings") (&/|contains? ?name) not)) + [inner outer] (&/|split-with no-binding? stack*)] + (matchv ::M/objects [outer] + [["lux;Nil" _]] + (resolve-global ident state) + + [["lux;Cons" [top-outer _]]] + (|let [in-stack (&/|cons top inner) + scopes (&/|tail (&/folds #(&/|cons (&/get$ "lux;name" %2) %1) + (&/|map #(&/get$ "lux;name" %) outer) + (&/|reverse in-stack))) + ;; _ (prn 'in-stack module-name ident (&/->seq (&/|map #(&/get$ "name" %) in-stack)) scopes) + [=local inner*] (&/fold (fn [register+new-inner frame+in-scope] + (|let [[register new-inner] register+new-inner + [frame in-scope] frame+in-scope + [register* frame*] (&&lambda/close-over (&/|cons module-name (&/|reverse in-scope)) ?name register frame)] + (&/T register* (&/|cons frame* new-inner)))) + (&/T (or (->> top-outer (&/get$ "lux;locals") (&/get$ "lux;mappings") (&/|get ?name)) + (->> top-outer (&/get$ "lux;closure") (&/get$ "lux;mappings") (&/|get ?name))) + (&/|list)) + (&/zip2 (&/|reverse in-stack) scopes))] + (return* (&/set$ "lux;local-envs" (&/|++ inner* outer) state) (&/|list =local))) + ))) + )) + )) + )))) (defn ^:private analyse-apply* [analyse =fn ?args] (exec [=args (&/flat-map% analyse ?args) @@ -105,22 +115,23 @@ (return (&/|list =apply)))) (defn analyse-apply [analyse =fn ?args] - ;; (prn 'analyse-apply (aget =fn 0)) + ;; (prn 'analyse-apply1 (aget =fn 0)) (exec [loader &/loader] (matchv ::M/objects [=fn] [["Expression" [=fn-form =fn-type]]] - (matchv ::M/objects [=fn-form] - [["global" [?module ?name]]] - (exec [macro? (&&def/macro? ?module ?name)] - (if macro? - (let [macro-class (&host/location (&/|list ?module ?name))] - (exec [macro-expansion (¯o/expand loader macro-class ?args) - output (&/flat-map% analyse macro-expansion)] - (return output))) - (analyse-apply* analyse =fn ?args))) - - [_] - (analyse-apply* analyse =fn ?args)) + (do ;; (prn 'analyse-apply2 (aget =fn-form 0)) + (matchv ::M/objects [=fn-form] + [["global" [?module ?name]]] + (exec [macro? (&&def/macro? ?module ?name)] + (if macro? + (let [macro-class (&host/location (&/|list ?module ?name))] + (exec [macro-expansion (¯o/expand loader macro-class ?args) + output (&/flat-map% analyse macro-expansion)] + (return output))) + (analyse-apply* analyse =fn ?args))) + + [_] + (analyse-apply* analyse =fn ?args))) [_] (fail "[Analyser Error] Can't call a statement!")) @@ -129,6 +140,7 @@ (defn analyse-case [analyse ?value ?branches] ;; (prn 'analyse-case (aget ?branches 0) (aget ?branches 1 1 0) ;; (&/->seq ?branches)) + ;; (prn 'analyse-case (&/show-ast ?value)) (exec [:let [num-branches (&/|length ?branches) ;; _ (prn 'analyse-case ?value (&/|length ?branches) ;; (and (> num-branches 0) (even? num-branches))) @@ -149,7 +161,7 @@ ;; :let [_ (prn '=bodies =bodies)] ;; :let [_ (prn 'analyse-case/=bodies =bodies)] =body-types (&/map% &&/expr-type =bodies) - =case-type (&/fold% &type/merge (&/V "Nothing" nil) =body-types) + =case-type (&/fold% &type/merge (&/V "lux;TNothing" nil) =body-types) :let [=branches (&/zip2 (&/|map &/|first branches) =bodies)]] (return (&/|list (&/V "Expression" (&/T (&/V "case" (&/T =value base-register max-locals =branches)) =case-type)))))) @@ -157,7 +169,7 @@ (defn analyse-lambda [analyse ?self ?arg ?body] (exec [=lambda-type* &type/fresh-lambda] (matchv ::M/objects [=lambda-type*] - [["Lambda" [=arg =return]]] + [["lux;TLambda" [=arg =return]]] (exec [[=scope =captured =body] (&&lambda/with-lambda ?self =lambda-type* ?arg =arg (&&/analyse-1 analyse ?body)) @@ -194,10 +206,13 @@ _ (&&def/define module-name ?name =value-type)] (return (&/|list (&/V "Statement" (&/V "def" (&/T ?name =value))))))))) -(defn analyse-declare-macro [?ident] - (exec [module-name &/get-module-name - _ (&&def/declare-macro module-name ?ident)] - (return (&/|list)))) +(defn analyse-declare-macro [ident] + (|let [[?module ?name] ident] + (exec [module-name &/get-module-name] + (if (= ?module module-name) + (exec [_ (&&def/declare-macro ?module ?name)] + (return (&/|list))) + (fail "Can't declare macros from foreign modules."))))) (defn analyse-import [analyse ?path] (assert false) diff --git a/src/lux/base.clj b/src/lux/base.clj index e4fc5b98f..2b6b17318 100644 --- a/src/lux/base.clj +++ b/src/lux/base.clj @@ -41,10 +41,10 @@ record#))) (defn fail* [message] - (V "Left" message)) + (V "lux;Left" message)) (defn return* [state value] - (V "Right" (T state value))) + (V "lux;Right" (T state value))) (defmacro |let [bindings body] (reduce (fn [inner [left right]] @@ -56,8 +56,8 @@ (defmacro |list [& elems] (reduce (fn [tail head] - `(V "Cons" (T ~head ~tail))) - `(V "Nil" nil) + `(V "lux;Cons" (T ~head ~tail))) + `(V "lux;Nil" nil) (reverse elems))) (defmacro |table [& elems] @@ -69,67 +69,67 @@ (defn |get [slot table] ;; (prn '|get slot (aget table 0)) (matchv ::M/objects [table] - [["Nil" _]] + [["lux;Nil" _]] nil - [["Cons" [[k v] table*]]] + [["lux;Cons" [[k v] table*]]] (if (= k slot) v (|get slot table*)))) (defn |put [slot value table] (matchv ::M/objects [table] - [["Nil" _]] - (V "Cons" (T (T slot value) (V "Nil" nil))) + [["lux;Nil" _]] + (V "lux;Cons" (T (T slot value) (V "lux;Nil" nil))) - [["Cons" [[k v] table*]]] + [["lux;Cons" [[k v] table*]]] (if (= k slot) - (V "Cons" (T (T slot value) table*)) - (V "Cons" (T (T k v) (|put slot value table*)))))) + (V "lux;Cons" (T (T slot value) table*)) + (V "lux;Cons" (T (T k v) (|put slot value table*)))))) (defn |merge [table1 table2] ;; (prn '|merge (aget table1 0) (aget table2 0)) (matchv ::M/objects [table2] - [["Nil" _]] + [["lux;Nil" _]] table1 - [["Cons" [[k v] table2*]]] + [["lux;Cons" [[k v] table2*]]] (|merge (|put k v table1) table2*))) (defn |update [k f table] (matchv ::M/objects [table] - [["Nil" _]] + [["lux;Nil" _]] table - [["Cons" [[k* v] table*]]] + [["lux;Cons" [[k* v] table*]]] (if (= k k*) - (V "Cons" (T (T k (f v)) table*)) + (V "lux;Cons" (T (T k (f v)) table*)) (|update k f table*)))) (defn |head [xs] (matchv ::M/objects [xs] - [["Nil" _]] + [["lux;Nil" _]] (assert false) - [["Cons" [x _]]] + [["lux;Cons" [x _]]] x)) (defn |tail [xs] (matchv ::M/objects [xs] - [["Nil" _]] + [["lux;Nil" _]] (assert false) - [["Cons" [_ xs*]]] + [["lux;Cons" [_ xs*]]] xs*)) ;; [Resources/Monads] (defn fail [message] (fn [_] - (V "Left" message))) + (V "lux;Left" message))) (defn return [value] (fn [state] - (V "Right" (T state value)))) + (V "lux;Right" (T state value)))) (defn bind [m-value step] ;; (prn 'bind m-value step) @@ -137,7 +137,7 @@ (let [inputs (m-value state)] ;; (prn 'bind/inputs (aget inputs 0)) (matchv ::M/objects [inputs] - [["Right" [?state ?datum]]] + [["lux;Right" [?state ?datum]]] ((step ?datum) ?state) [_] @@ -158,83 +158,83 @@ (defn try% [monad] (fn [state] (matchv ::M/objects [(monad state)] - [["Right" [?state ?datum]]] + [["lux;Right" [?state ?datum]]] (return* ?state ?datum) [_] (return* state nil)))) (defn |cons [head tail] - (V "Cons" (T head tail))) + (V "lux;Cons" (T head tail))) (defn |++ [xs ys] ;; (prn '|++ (and xs (aget xs 0)) (and ys (aget ys 0))) (matchv ::M/objects [xs] - [["Nil" _]] + [["lux;Nil" _]] ys - [["Cons" [x xs*]]] - (V "Cons" (T x (|++ xs* ys))))) + [["lux;Cons" [x xs*]]] + (V "lux;Cons" (T x (|++ xs* ys))))) (defn |map [f xs] (matchv ::M/objects [xs] - [["Nil" _]] + [["lux;Nil" _]] xs - [["Cons" [x xs*]]] - (V "Cons" (T (f x) (|map f xs*))))) + [["lux;Cons" [x xs*]]] + (V "lux;Cons" (T (f x) (|map f xs*))))) (defn flat-map [f xs] (matchv ::M/objects [xs] - [["Nil" _]] + [["lux;Nil" _]] xs - [["Cons" [x xs*]]] + [["lux;Cons" [x xs*]]] (|++ (f x) (flat-map f xs*)))) (defn |split-with [p xs] (matchv ::M/objects [xs] - [["Nil" _]] + [["lux;Nil" _]] (T xs xs) - [["Cons" [x xs*]]] + [["lux;Cons" [x xs*]]] (if (p x) (|let [[pre post] (|split-with p xs*)] (T (|cons x pre) post)) - (T (V "Nil" nil) xs)))) + (T (V "lux;Nil" nil) xs)))) (defn |contains? [k table] (matchv ::M/objects [table] - [["Nil" _]] + [["lux;Nil" _]] false - [["Cons" [[k* _] table*]]] + [["lux;Cons" [[k* _] table*]]] (or (= k k*) (|contains? k table*)))) (defn fold [f init xs] (matchv ::M/objects [xs] - [["Nil" _]] + [["lux;Nil" _]] init - [["Cons" [x xs*]]] + [["lux;Cons" [x xs*]]] (fold f (f init x) xs*))) (defn fold% [f init xs] (matchv ::M/objects [xs] - [["Nil" _]] + [["lux;Nil" _]] (return init) - [["Cons" [x xs*]]] + [["lux;Cons" [x xs*]]] (exec [init* (f init x)] (fold% f init* xs*)))) (defn folds [f init xs] (matchv ::M/objects [xs] - [["Nil" _]] + [["lux;Nil" _]] (|list init) - [["Cons" [x xs*]]] + [["lux;Cons" [x xs*]]] (|cons init (folds f (f init x) xs*)))) (defn |length [xs] @@ -243,8 +243,8 @@ (let [|range* (fn |range* [from to] (if (< from to) - (V "Cons" (T from (|range* (inc from) to))) - (V "Nil" nil)))] + (V "lux;Cons" (T from (|range* (inc from) to))) + (V "lux;Nil" nil)))] (defn |range [n] (|range* 0 n))) @@ -258,38 +258,38 @@ (defn zip2 [xs ys] (matchv ::M/objects [xs ys] - [["Cons" [x xs*]] ["Cons" [y ys*]]] - (V "Cons" (T (T x y) (zip2 xs* ys*))) + [["lux;Cons" [x xs*]] ["lux;Cons" [y ys*]]] + (V "lux;Cons" (T (T x y) (zip2 xs* ys*))) [_ _] - (V "Nil" nil))) + (V "lux;Nil" nil))) (defn |keys [plist] (matchv ::M/objects [plist] - [["Nil" _]] + [["lux;Nil" _]] (|list) - [["Cons" [[k v] plist*]]] + [["lux;Cons" [[k v] plist*]]] (|cons k (|keys plist*)))) (defn |interpose [sep xs] (matchv ::M/objects [xs] - [["Nil" _]] + [["lux;Nil" _]] xs - [["Cons" [_ ["Nil" _]]]] + [["lux;Cons" [_ ["lux;Nil" _]]]] xs - [["Cons" [x xs*]]] - (V "Cons" (T x (V "Cons" (T sep (|interpose sep xs*))))))) + [["lux;Cons" [x xs*]]] + (V "lux;Cons" (T x (V "lux;Cons" (T sep (|interpose sep xs*))))))) (do-template [ ] (defn [f xs] (matchv ::M/objects [xs] - [["Nil" _]] + [["lux;Nil" _]] (return xs) - [["Cons" [x xs*]]] + [["lux;Cons" [x xs*]]] (exec [y (f x) ys ( f xs*)] (return ( y ys))))) @@ -299,11 +299,11 @@ (defn |as-pairs [xs] (matchv ::M/objects [xs] - [["Cons" [x ["Cons" [y xs*]]]]] - (V "Cons" (T (T x y) (|as-pairs xs*))) + [["lux;Cons" [x ["lux;Cons" [y xs*]]]]] + (V "lux;Cons" (T (T x y) (|as-pairs xs*))) [_] - (V "Nil" nil))) + (V "lux;Nil" nil))) (defn |reverse [xs] (fold (fn [tail head] @@ -332,7 +332,7 @@ (let [output (monad call-state)] ;; (prn 'apply-m/output output) (matchv ::M/objects [output] - [["Right" [?state ?datum]]] + [["lux;Right" [?state ?datum]]] (return* state ?datum) [_] @@ -357,7 +357,7 @@ (defn sequence% [m-values] (matchv ::M/objects [m-values] - [["Cons" [head tail]]] + [["lux;Cons" [head tail]]] (exec [_ head] (sequence% tail)) @@ -367,20 +367,20 @@ (defn repeat% [monad] (fn [state] (matchv ::M/objects [(monad state)] - [["Right" [?state ?head]]] + [["lux;Right" [?state ?head]]] (do ;; (prn 'repeat-m/?state ?state) (matchv ::M/objects [((repeat% monad) ?state)] - [["Right" [?state* ?tail]]] + [["lux;Right" [?state* ?tail]]] (do ;; (prn 'repeat-m/?state* ?state*) (return* ?state* (|cons ?head ?tail))))) - [["Left" ?message]] + [["lux;Left" ?message]] (do ;; (println "Failed at last:" ?message) - (return* state (V "Nil" nil)))))) + (return* state (V "lux;Nil" nil)))))) (def source-consumed? (fn [state] - (return* state (empty? (get$ "source" state))))) + (return* state (empty? (get$ "lux;source" state))))) (defn exhaust% [monad] (exec [output-h monad @@ -392,17 +392,17 @@ (defn try-all% [monads] (matchv ::M/objects [monads] - [["Nil" _]] + [["lux;Nil" _]] (fail "There are no alternatives to try!") - [["Cons" [m monads*]]] + [["lux;Cons" [m monads*]]] (fn [state] (let [output (m state)] (matchv ::M/objects [output monads*] - [["Right" _] _] + [["lux;Right" _] _] output - [_ ["Nil" _]] + [_ ["lux;Nil" _]] output [_ _] @@ -442,72 +442,78 @@ (def loader (fn [state] - (return* state (get$ "loader" state)))) + (return* state (get$ "lux;loader" state)))) (def +init-bindings+ - (R "counter" 0 - "mappings" (|list))) + (R "lux;counter" 0 + "lux;mappings" (|table))) (defn env [name] - (R "name" name - "inner-closures" 0 - "locals" +init-bindings+ - "closure" +init-bindings+)) + (R "lux;name" name + "lux;inner-closures" 0 + "lux;locals" +init-bindings+ + "lux;closure" +init-bindings+)) (defn init-state [_] - (R "source" (V "None" nil) - "modules" (|list) - "global-env" (V "None" nil) - "local-envs" (|list) - "types" +init-bindings+ - "writer" (V "None" nil) - "loader" (-> (java.io.File. "./output/") .toURL vector into-array java.net.URLClassLoader.) - "eval-ctor" 0)) + (R "lux;source" (V "lux;None" nil) + "lux;modules" (|table) + "lux;module-aliases" (|table) + "lux;global-env" (V "lux;None" nil) + "lux;local-envs" (|list) + "lux;types" +init-bindings+ + "lux;writer" (V "lux;None" nil) + "lux;loader" (-> (java.io.File. "./output/") .toURL vector into-array java.net.URLClassLoader.) + "lux;eval-ctor" 0)) (defn from-some [some] (matchv ::M/objects [some] - [["Some" datum]] + [["lux;Some" datum]] datum [_] (assert false))) (defn show-state [state] - (let [source (get$ "source" state) - modules (get$ "modules" state) - global-env (get$ "global-env" state) - local-envs (get$ "local-envs" state) - types (get$ "types" state) - writer (get$ "writer" state) - loader (get$ "loader" state) - eval-ctor (get$ "eval-ctor" state)] + (let [source (get$ "lux;source" state) + modules (get$ "lux;modules" state) + global-env (get$ "lux;global-env" state) + local-envs (get$ "lux;local-envs" state) + types (get$ "lux;types" state) + writer (get$ "lux;writer" state) + loader (get$ "lux;loader" state) + eval-ctor (get$ "lux;eval-ctor" state)] (str "{" - (->> (for [slot ["source", "modules", "global-env", "local-envs", "types", "writer", "loader", "eval-ctor"] + (->> (for [slot ["lux;source", "lux;modules", "lux;global-env", "lux;local-envs", "lux;types", "lux;writer", "lux;loader", "lux;eval-ctor"] :let [value (get$ slot state)]] (str "#" slot " " (case slot - "source" "???" - "modules" "???" - "global-env" (->> value from-some (get$ "locals") (get$ "mappings") show-table) - "local-envs" (|length value) - "types" "???" - "writer" "???" - "loader" "???" - "eval-ctor" value))) + "lux;source" "???" + "lux;modules" "???" + "lux;global-env" (->> value from-some (get$ "lux;locals") (get$ "lux;mappings") show-table) + "lux;local-envs" (str "(" + (->> value + (|map #(->> % (get$ "lux;locals") (get$ "lux;mappings") show-table)) + (|interpose " ") + (fold str "")) + ")") + "lux;types" "???" + "lux;writer" "???" + "lux;loader" "???" + "lux;eval-ctor" value))) (interpose " ") (reduce str "")) "}"))) (def get-eval-ctor (fn [state] - (return* (update$ "eval-ctor" inc state) (get$ "eval-ctor" state)))) + (return* (update$ "lux;eval-ctor" inc state) (get$ "lux;eval-ctor" state)))) (def get-writer (fn [state] - (let [writer* (get$ "writer" state)] + (let [writer* (get$ "lux;writer" state)] ;; (prn 'get-writer (class writer*)) ;; (prn 'get-writer (aget writer* 0)) (matchv ::M/objects [writer*] - [["Some" datum]] + [["lux;Some" datum]] (return* state datum) [_] @@ -515,17 +521,17 @@ (def get-top-local-env (fn [state] - (try (let [top (|head (get$ "local-envs" state))] + (try (let [top (|head (get$ "lux;local-envs" state))] (return* state top)) (catch Throwable _ (fail "No local environment."))))) (def get-current-module-env (fn [state] - (let [global-env* (get$ "global-env" state)] + (let [global-env* (get$ "lux;global-env" state)] ;; (prn 'get-current-module-env (aget global-env* 0)) (matchv ::M/objects [global-env*] - [["Some" datum]] + [["lux;Some" datum]] (return* state datum) [_] @@ -533,10 +539,10 @@ (defn ->seq [xs] (matchv ::M/objects [xs] - [["Nil" _]] + [["lux;Nil" _]] (list) - [["Cons" [x xs*]]] + [["lux;Cons" [x xs*]]] (cons x (->seq xs*)))) (defn ->list [seq] @@ -551,35 +557,35 @@ (def get-module-name (exec [module get-current-module-env] - (return (get$ "name" module)))) + (return (get$ "lux;name" module)))) (defn ^:private with-scope [name body] (fn [state] - (let [output (body (update$ "local-envs" #(|cons (env name) %) state))] + (let [output (body (update$ "lux;local-envs" #(|cons (env name) %) state))] (matchv ::M/objects [output] - [["Right" [state* datum]]] - (return* (update$ "local-envs" |tail state*) datum) + [["lux;Right" [state* datum]]] + (return* (update$ "lux;local-envs" |tail state*) datum) [_] output)))) (defn with-closure [body] (exec [closure-info (try-all% (|list (exec [top get-top-local-env] - (return (T true (->> top (get$ "inner-closures") str)))) + (return (T true (->> top (get$ "lux;inner-closures") str)))) (exec [global get-current-module-env] - (return (T false (->> global (get$ "inner-closures") str))))))] + (return (T false (->> global (get$ "lux;inner-closures") str))))))] (matchv ::M/objects [closure-info] [[local? closure-name]] (fn [state] (let [body* (with-scope closure-name body)] (body* (if local? - (update$ "local-envs" #(|cons (update$ "inner-closures" inc (|head %)) + (update$ "lux;local-envs" #(|cons (update$ "lux;inner-closures" inc (|head %)) (|tail %)) state) - (update$ "global-env" #(matchv ::M/objects [%] - [["Some" global-env]] - (V "Some" (update$ "inner-closures" inc global-env)) + (update$ "lux;global-env" #(matchv ::M/objects [%] + [["lux;Some" global-env]] + (V "lux;Some" (update$ "lux;inner-closures" inc global-env)) [_] %) @@ -589,14 +595,14 @@ (def get-scope-name (exec [module-name get-module-name] (fn [state] - (return* state (->> state (get$ "local-envs") (|map #(get$ "name" %)) |reverse (|cons module-name)))))) + (return* state (->> state (get$ "lux;local-envs") (|map #(get$ "lux;name" %)) |reverse (|cons module-name)))))) (defn with-writer [writer body] (fn [state] - (let [output (body (set$ "writer" (V "Some" writer) state))] + (let [output (body (set$ "lux;writer" (V "lux;Some" writer) state))] (matchv ::M/objects [output] - [["Right" [?state ?value]]] - (return* (set$ "writer" (get$ "writer" state) ?state) ?value) + [["lux;Right" [?state ?value]]] + (return* (set$ "lux;writer" (get$ "lux;writer" state) ?state) ?value) [_] output)))) @@ -605,31 +611,32 @@ (monad state)) (defn show-ast [ast] + ;; (prn 'show-ast (aget ast 0)) (matchv ::M/objects [ast] - [["Bool" ?value]] + [["lux;Bool" ?value]] (pr-str ?value) - [["Int" ?value]] + [["lux;Int" ?value]] (pr-str ?value) - [["Real" ?value]] + [["lux;Real" ?value]] (pr-str ?value) - [["Char" ?value]] + [["lux;Char" ?value]] (pr-str ?value) - [["Text" ?value]] + [["lux;Text" ?value]] (str "\"" ?value "\"") - [["Tag" ?tag]] - (str "#" ?tag) + [["lux;Tag" [?module ?tag]]] + (str "#" ?module ";" ?tag) - [["Symbol" ?ident]] - ?ident + [["lux;Symbol" [?module ?ident]]] + (str ?module ";" ?ident) - [["Tuple" ?elems]] + [["lux;Tuple" ?elems]] (str "[" (->> ?elems (|map show-ast) (|interpose " ") (fold str "")) "]") - [["Form" ?elems]] + [["lux;Form" ?elems]] (str "(" (->> ?elems (|map show-ast) (|interpose " ") (fold str "")) ")") )) diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index 395d12779..d90171b2a 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -319,15 +319,15 @@ (matchv ::M/objects [syntax] [["Statement" ?form]] (do ;; (prn 'compile-statement (aget syntax 0) (aget ?form 0)) - (matchv ::M/objects [?form] - [["def" [?name ?body]]] - (&&lux/compile-def compile-expression ?name ?body) - - [["jvm-interface" [?package ?name ?methods]]] - (&&host/compile-jvm-interface compile-expression ?package ?name ?methods) + (matchv ::M/objects [?form] + [["def" [?name ?body]]] + (&&lux/compile-def compile-expression ?name ?body) + + [["jvm-interface" [?package ?name ?methods]]] + (&&host/compile-jvm-interface compile-expression ?package ?name ?methods) - [["jvm-class" [?package ?name ?super-class ?fields ?methods]]] - (&&host/compile-jvm-class compile-expression ?package ?name ?super-class ?fields ?methods))) + [["jvm-class" [?package ?name ?super-class ?fields ?methods]]] + (&&host/compile-jvm-class compile-expression ?package ?name ?super-class ?fields ?methods))) [_] (fail "[Compiler Error] Can't compile expressions as top-level forms."))) @@ -366,36 +366,36 @@ (&/map% compile-statement analysis+))] (defn ^:private compile-module [name] (fn [state] - (if (->> state (&/get$ "modules") (&/|contains? name)) + (if (->> state (&/get$ "lux;modules") (&/|contains? name)) (fail "[Compiler Error] Can't redefine a module!") (let [=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER) (&host/->class name) nil "java/lang/Object" nil))] (matchv ::M/objects [(&/run-state (&/exhaust% compiler-step) (->> state - (&/set$ "source" (slurp (str "source/" name ".lux"))) - (&/set$ "global-env" (&/V "Some" (&/env name))) - (&/set$ "writer" (&/V "Some" =class)) - (&/update$ "modules" #(&/|put name &a-def/init-module %))))] - [["Right" [?state ?vals]]] + (&/set$ "lux;source" (slurp (str "source/" name ".lux"))) + (&/set$ "lux;global-env" (&/V "lux;Some" (&/env name))) + (&/set$ "lux;writer" (&/V "lux;Some" =class)) + (&/update$ "lux;modules" #(&/|put name &a-def/init-module %))))] + [["lux;Right" [?state ?vals]]] (do (.visitEnd =class) ;; (prn 'compile-module 'DONE name) ;; (prn 'compile-module/?vals ?vals) (&/run-state (&&/save-class! name (.toByteArray =class)) ?state)) - [["Left" ?message]] + [["lux;Left" ?message]] (fail* ?message))))))) ;; [Resources] (defn compile-all [modules] (.mkdir (java.io.File. "output")) (matchv ::M/objects [(&/run-state (&/map% compile-module modules) (&/init-state nil))] - [["Right" [?state _]]] + [["lux;Right" [?state _]]] (println (str "Compilation complete! " (str "[" (->> modules (&/|interpose " ") (&/fold str "")) "]"))) - [["Left" ?message]] + [["lux;Left" ?message]] (do (prn 'compile-all '?message ?message) (assert false ?message)))) diff --git a/src/lux/compiler/base.clj b/src/lux/compiler/base.clj index 7fcda55a3..eeac182e0 100644 --- a/src/lux/compiler/base.clj +++ b/src/lux/compiler/base.clj @@ -36,100 +36,100 @@ (matchv ::M/objects [expr] [["Expression" [?struct ?type]]] (do ;; (prn 'total-locals2 (aget ?struct 0)) - (matchv ::M/objects [?struct] - [["case" [?variant ?base-register ?num-registers ?branches]]] - (+ ?num-registers (&/fold max 0 (&/|map (comp total-locals second) ?branches))) - - [["tuple" ?members]] - (&/fold max 0 (&/|map total-locals ?members)) + (matchv ::M/objects [?struct] + [["case" [?variant ?base-register ?num-registers ?branches]]] + (+ ?num-registers (&/fold max 0 (&/|map (comp total-locals second) ?branches))) + + [["tuple" ?members]] + (&/fold max 0 (&/|map total-locals ?members)) - [["variant" [?tag ?value]]] - (total-locals ?value) + [["variant" [?tag ?value]]] + (total-locals ?value) - [["call" [?fn ?args]]] - (&/fold max 0 (&/|map total-locals (&/|cons ?fn ?args))) - - [["jvm-iadd" [?x ?y]]] - (&/fold max 0 (&/|map total-locals (&/|list ?x ?y))) - - [["jvm-isub" [?x ?y]]] - (&/fold max 0 (&/|map total-locals (&/|list ?x ?y))) - - [["jvm-imul" [?x ?y]]] - (&/fold max 0 (&/|map total-locals (&/|list ?x ?y))) - - [["jvm-idiv" [?x ?y]]] - (&/fold max 0 (&/|map total-locals (&/|list ?x ?y))) - - [["jvm-irem" [?x ?y]]] - (&/fold max 0 (&/|map total-locals (&/|list ?x ?y))) - - [["jvm-ladd" [?x ?y]]] - (&/fold max 0 (&/|map total-locals (&/|list ?x ?y))) - - [["jvm-lsub" [?x ?y]]] - (&/fold max 0 (&/|map total-locals (&/|list ?x ?y))) - - [["jvm-lmul" [?x ?y]]] - (&/fold max 0 (&/|map total-locals (&/|list ?x ?y))) - - [["jvm-ldiv" [?x ?y]]] - (&/fold max 0 (&/|map total-locals (&/|list ?x ?y))) - - [["jvm-lrem" [?x ?y]]] - (&/fold max 0 (&/|map total-locals (&/|list ?x ?y))) - - [["jvm-fadd" [?x ?y]]] - (&/fold max 0 (&/|map total-locals (&/|list ?x ?y))) - - [["jvm-fsub" [?x ?y]]] - (&/fold max 0 (&/|map total-locals (&/|list ?x ?y))) - - [["jvm-fmul" [?x ?y]]] - (&/fold max 0 (&/|map total-locals (&/|list ?x ?y))) - - [["jvm-fdiv" [?x ?y]]] - (&/fold max 0 (&/|map total-locals (&/|list ?x ?y))) - - [["jvm-frem" [?x ?y]]] - (&/fold max 0 (&/|map total-locals (&/|list ?x ?y))) - - [["jvm-dadd" [?x ?y]]] - (&/fold max 0 (&/|map total-locals (&/|list ?x ?y))) - - [["jvm-dsub" [?x ?y]]] - (&/fold max 0 (&/|map total-locals (&/|list ?x ?y))) - - [["jvm-dmul" [?x ?y]]] - (&/fold max 0 (&/|map total-locals (&/|list ?x ?y))) - - [["jvm-ddiv" [?x ?y]]] - (&/fold max 0 (&/|map total-locals (&/|list ?x ?y))) - - [["jvm-drem" [?x ?y]]] - (&/fold max 0 (&/|map total-locals (&/|list ?x ?y))) + [["call" [?fn ?args]]] + (&/fold max 0 (&/|map total-locals (&/|cons ?fn ?args))) + + [["jvm-iadd" [?x ?y]]] + (&/fold max 0 (&/|map total-locals (&/|list ?x ?y))) + + [["jvm-isub" [?x ?y]]] + (&/fold max 0 (&/|map total-locals (&/|list ?x ?y))) + + [["jvm-imul" [?x ?y]]] + (&/fold max 0 (&/|map total-locals (&/|list ?x ?y))) + + [["jvm-idiv" [?x ?y]]] + (&/fold max 0 (&/|map total-locals (&/|list ?x ?y))) + + [["jvm-irem" [?x ?y]]] + (&/fold max 0 (&/|map total-locals (&/|list ?x ?y))) + + [["jvm-ladd" [?x ?y]]] + (&/fold max 0 (&/|map total-locals (&/|list ?x ?y))) + + [["jvm-lsub" [?x ?y]]] + (&/fold max 0 (&/|map total-locals (&/|list ?x ?y))) + + [["jvm-lmul" [?x ?y]]] + (&/fold max 0 (&/|map total-locals (&/|list ?x ?y))) + + [["jvm-ldiv" [?x ?y]]] + (&/fold max 0 (&/|map total-locals (&/|list ?x ?y))) + + [["jvm-lrem" [?x ?y]]] + (&/fold max 0 (&/|map total-locals (&/|list ?x ?y))) + + [["jvm-fadd" [?x ?y]]] + (&/fold max 0 (&/|map total-locals (&/|list ?x ?y))) + + [["jvm-fsub" [?x ?y]]] + (&/fold max 0 (&/|map total-locals (&/|list ?x ?y))) + + [["jvm-fmul" [?x ?y]]] + (&/fold max 0 (&/|map total-locals (&/|list ?x ?y))) + + [["jvm-fdiv" [?x ?y]]] + (&/fold max 0 (&/|map total-locals (&/|list ?x ?y))) + + [["jvm-frem" [?x ?y]]] + (&/fold max 0 (&/|map total-locals (&/|list ?x ?y))) + + [["jvm-dadd" [?x ?y]]] + (&/fold max 0 (&/|map total-locals (&/|list ?x ?y))) + + [["jvm-dsub" [?x ?y]]] + (&/fold max 0 (&/|map total-locals (&/|list ?x ?y))) + + [["jvm-dmul" [?x ?y]]] + (&/fold max 0 (&/|map total-locals (&/|list ?x ?y))) + + [["jvm-ddiv" [?x ?y]]] + (&/fold max 0 (&/|map total-locals (&/|list ?x ?y))) + + [["jvm-drem" [?x ?y]]] + (&/fold max 0 (&/|map total-locals (&/|list ?x ?y))) - [["exec" ?exprs]] - (&/fold max 0 (&/|map total-locals ?exprs)) + [["exec" ?exprs]] + (&/fold max 0 (&/|map total-locals ?exprs)) - [["jvm-new" [?class ?classes ?args]]] - (&/fold max 0 (&/|map total-locals ?args)) + [["jvm-new" [?class ?classes ?args]]] + (&/fold max 0 (&/|map total-locals ?args)) - [["jvm-invokestatic" [?class ?method ?classes ?args]]] - (&/fold max 0 (&/|map total-locals ?args)) + [["jvm-invokestatic" [?class ?method ?classes ?args]]] + (&/fold max 0 (&/|map total-locals ?args)) - [["jvm-invokevirtual" [?class ?method ?classes ?object ?args]]] - (&/fold max 0 (&/|map total-locals ?args)) + [["jvm-invokevirtual" [?class ?method ?classes ?object ?args]]] + (&/fold max 0 (&/|map total-locals ?args)) - [["jvm-aastore" [?array ?idx ?elem]]] - (&/fold max 0 (&/|map total-locals (&/|list ?array ?elem))) + [["jvm-aastore" [?array ?idx ?elem]]] + (&/fold max 0 (&/|map total-locals (&/|list ?array ?elem))) - [["jvm-aaload" [?array ?idx]]] - (total-locals ?array) + [["jvm-aaload" [?array ?idx]]] + (total-locals ?array) - ;; [["lambda" _]] - ;; 0 - - [_] - 0 - )))) + ;; [["lambda" _]] + ;; 0 + + [_] + 0 + )))) diff --git a/src/lux/compiler/case.clj b/src/lux/compiler/case.clj index b54d2e83a..10f451587 100644 --- a/src/lux/compiler/case.clj +++ b/src/lux/compiler/case.clj @@ -20,25 +20,25 @@ ;; (prn '->match token) ;; (prn '->match (aget token 0)) (matchv ::M/objects [token] - [["Symbol" ?name]] + [["lux;Symbol" [_ ?name]]] (&/T (inc register) (&/V "Pattern" (&/T $body (&/V "StoreMatch" register)))) - [["Bool" ?value]] + [["lux;Bool" ?value]] (&/T register (&/V "Pattern" (&/T $body (&/V "BoolMatch" ?value)))) - [["Int" ?value]] + [["lux;Int" ?value]] (&/T register (&/V "Pattern" (&/T $body (&/V "IntMatch" ?value)))) - [["Real" ?value]] + [["lux;Real" ?value]] (&/T register (&/V "Pattern" (&/T $body (&/V "RealMatch" ?value)))) - [["Char" ?value]] + [["lux;Char" ?value]] (&/T register (&/V "Pattern" (&/T $body (&/V "CharMatch" ?value)))) - [["Text" ?value]] + [["lux;Text" ?value]] (&/T register (&/V "Pattern" (&/T $body (&/V "TextMatch" ?value)))) - [["Tuple" ?members]] + [["lux;Tuple" ?members]] (|let [[register* =members] (&/fold (fn [register+=members member] ;; (prn 'register+=members (alength register+=members)) (|let [[_register =members] register+=members @@ -50,13 +50,15 @@ ?members)] (&/T register* (&/V "Pattern" (&/T $body (&/V "TupleMatch" (&/|reverse =members)))))) - [["Tag" ?tag]] - (&/T register (&/V "Pattern" (&/T $body (&/V "VariantMatch" (&/T ?tag (&/V "Pattern" (&/T $body (&/V "TupleMatch" (&/|list))))))))) + [["lux;Tag" [?module ?name]]] + (|let [?tag (str ?module ";" ?name)] + (&/T register (&/V "Pattern" (&/T $body (&/V "VariantMatch" (&/T ?tag (&/V "Pattern" (&/T $body (&/V "TupleMatch" (&/|list)))))))))) - [["Form" ["Cons" [["Tag" ?tag] - ["Cons" [?value - ["Nil" _]]]]]]] - (|let [[register* =value] (->match $body register ?value)] + [["lux;Form" ["lux;Cons" [["lux;Tag" [?module ?name]] + ["lux;Cons" [?value + ["lux;Nil" _]]]]]]] + (|let [?tag (str ?module ";" ?name) + [register* =value] (->match $body register ?value)] (&/T register* (&/V "Pattern" (&/T $body (&/V "VariantMatch" (&/T ?tag =value)))))) )) diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj index 4789a9b7e..c46684622 100644 --- a/src/lux/compiler/host.clj +++ b/src/lux/compiler/host.clj @@ -40,22 +40,22 @@ char-class "java.lang.Character"] (defn prepare-return! [*writer* *type*] (matchv ::M/objects [*type*] - [["Nothing" nil]] + [["lux;TNothing" nil]] (.visitInsn *writer* Opcodes/ACONST_NULL) - [["Data" ["char" _]]] + [["lux;TData" ["char" _]]] (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host/->class char-class) "valueOf" (str "(C)" (&host/->type-signature char-class))) - [["Data" ["int" _]]] + [["lux;TData" ["int" _]]] (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host/->class integer-class) "valueOf" (str "(I)" (&host/->type-signature integer-class))) - [["Data" ["long" _]]] + [["lux;TData" ["long" _]]] (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host/->class long-class) "valueOf" (str "(J)" (&host/->type-signature long-class))) - [["Data" ["boolean" _]]] + [["lux;TData" ["boolean" _]]] (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host/->class boolean-class) "valueOf" (str "(Z)" (&host/->type-signature boolean-class))) - [["Data" [_ _]]] + [["lux;TData" [_ _]]] nil) *writer*)) @@ -331,10 +331,10 @@ (defn compile-exec [compile *type* ?exprs] (exec [*writer* &/get-writer _ (&/map% (fn [expr] - (exec [ret (compile expr) - :let [_ (.visitInsn *writer* Opcodes/POP)]] - (return ret))) - (butlast ?exprs)) + (exec [ret (compile expr) + :let [_ (.visitInsn *writer* Opcodes/POP)]] + (return ret))) + (butlast ?exprs)) _ (compile (last ?exprs))] (return nil))) @@ -359,13 +359,13 @@ :let [_ (.visitLabel *writer* $to)] _ compile-finally handlers (&/map% (fn [[?ex-class ?ex-arg ?catch-body]] - (exec [:let [$handler-start (new Label) - $handler-end (new Label)] - _ (compile ?catch-body) - :let [_ (.visitLabel *writer* $handler-end)] - _ compile-finally] - (return [?ex-class $handler-start $handler-end]))) - ?catches) + (exec [:let [$handler-start (new Label) + $handler-end (new Label)] + _ (compile ?catch-body) + :let [_ (.visitLabel *writer* $handler-end)] + _ compile-finally] + (return [?ex-class $handler-start $handler-end]))) + ?catches) :let [_ (.visitLabel *writer* $catch-finally)] _ (if ?finally (exec [_ (compile ?finally) diff --git a/src/lux/compiler/lambda.clj b/src/lux/compiler/lambda.clj index 2b9913fe9..7d53fa739 100644 --- a/src/lux/compiler/lambda.clj +++ b/src/lux/compiler/lambda.clj @@ -65,7 +65,7 @@ $start (new Label) $end (new Label) _ (doto *writer* - (-> (.visitLocalVariable (str &&/local-prefix idx) (&host/->java-sig (&/V "Any" nil)) nil $start $end (+ 2 idx)) + (-> (.visitLocalVariable (str &&/local-prefix idx) (&host/->java-sig (&/V "lux;TAny" nil)) nil $start $end (+ 2 idx)) (->> (dotimes [idx num-locals]))) (.visitLabel $start))] ret (compile impl-body) @@ -109,7 +109,9 @@ (matchv ::M/objects [?name+?captured] [[?name ["Expression" [["captured" [_ ?captured-id ?source]] _]]]]) (doseq [?name+?captured (&/->seq ?env) - ;; :let [_ (prn '?captured ?name ?captured)] + ;; :let [_ (prn '?name+?captured (alength ?name+?captured)) + ;; _ (prn '?name+?captured (aget ?name+?captured 1 0)) + ;; _ (prn '?name+?captured (aget ?name+?captured 1 1 0 0))] ]))) (add-lambda-apply lambda-class ?env) (add-lambda- lambda-class ?env) diff --git a/src/lux/host.clj b/src/lux/host.clj index 267f77eb6..8954792d3 100644 --- a/src/lux/host.clj +++ b/src/lux/host.clj @@ -19,11 +19,11 @@ "") (.getSimpleName class)))] (if (= "void" base) - (return (&/V "Nothing" nil)) - (let [base* (&/V "Data" (to-array [base (&/V "Nil" nil)]))] + (return (&/V "lux;TNothing" nil)) + (let [base* (&/V "lux;TData" (&/T base (&/V "lux;Nil" nil)))] (if arr-level (return (reduce (fn [inner _] - (&/V "array" (&/V "Cons" (to-array [inner (&/V "Nil" nil)])))) + (&/V "array" (&/V "lux;Cons" (&/T inner (&/V "lux;Nil" nil))))) base* (range (/ (count arr-level) 2.0)))) (return base*))) @@ -51,6 +51,7 @@ (fail "[Analyser Error] Unknown class."))))) (defn full-class-name [class-name] + ;; (prn 'full-class-name class-name) (exec [=class (full-class class-name)] (return (.getName =class)))) @@ -60,6 +61,7 @@ (def ->package ->class) (defn ->type-signature [class] + (assert (string? class)) (case class "void" "V" "boolean" "Z" @@ -79,27 +81,27 @@ (defn ->java-sig [type] (matchv ::M/objects [type] - [["Any" _]] + [["lux;TAny" _]] (->type-signature "java.lang.Object") - [["Nothing" _]] + [["lux;TNothing" _]] "V" - [["Data" ["array" ["Cons" [?elem ["Nil" _]]]]]] + [["lux;TData" ["array" ["lux;Cons" [?elem ["lux;Nil" _]]]]]] (str "[" (->java-sig ?elem)) - [["Data" [?name ?params]]] + [["lux;TData" [?name ?params]]] (->type-signature ?name) - [["Lambda" [_ _]]] + [["lux;TLambda" [_ _]]] (->type-signature function-class))) (defn extract-jvm-param [token] (matchv ::M/objects [token] - [["Symbol" ?ident]] + [["lux;Symbol" [_ ?ident]]] (full-class-name ?ident) - [["Form" ["Cons" [["Symbol" "Array"] ["Cons" [["Symbol" ?inner] ["Nil" _]]]]]]] + [["lux;Form" ["lux;Cons" [["lux;Symbol" [_ "Array"]] ["lux;Cons" [["lux;Symbol" [_ ?inner]] ["lux;Nil" _]]]]]]] (exec [=inner (full-class-name ?inner)] (return (str "[L" (->class =inner) ";"))) diff --git a/src/lux/lexer.clj b/src/lux/lexer.clj index cbdf24ff4..2501161ac 100644 --- a/src/lux/lexer.clj +++ b/src/lux/lexer.clj @@ -1,24 +1,25 @@ (ns lux.lexer (:require [clojure.template :refer [do-template]] - [lux.base :as & :refer [exec return* return fail fail*]])) + [lux.base :as & :refer [exec return* return fail fail*]] + [lux.analyser.def :as &def])) ;; [Utils] (defn ^:private lex-regex [regex] (fn [state] - (if-let [[match] (re-find regex (&/get$ "source" state))] - (return* (&/update$ "source" #(.substring % (.length match)) state) match) + (if-let [[match] (re-find regex (&/get$ "lux;source" state))] + (return* (&/update$ "lux;source" #(.substring % (.length match)) state) match) (fail* (str "[Lexer Error] Pattern failed: " regex))))) (defn ^:private lex-regex2 [regex] (fn [state] - (if-let [[match tok1 tok2] (re-find regex (&/get$ "source" state))] - (return* (&/update$ "source" #(.substring % (.length match)) state) [tok1 tok2]) + (if-let [[match tok1 tok2] (re-find regex (&/get$ "lux;source" state))] + (return* (&/update$ "lux;source" #(.substring % (.length match)) state) [tok1 tok2]) (fail* (str "[Lexer Error] Pattern failed: " regex))))) (defn ^:private lex-prefix [prefix] (fn [state] - (if (.startsWith (&/get$ "source" state) prefix) - (return* (&/update$ "source" #(.substring % (.length prefix)) state) prefix) + (if (.startsWith (&/get$ "lux;source" state) prefix) + (return* (&/update$ "lux;source" #(.substring % (.length prefix)) state) prefix) (fail* (str "[Lexer Error] Text failed: " prefix))))) (defn ^:private escape-char [escaped] @@ -40,7 +41,7 @@ (return (str prefix unescaped postfix))) (lex-regex #"(?s)^([^\"\\]*)")))) -(def ^:private +ident-re+ #"^([a-zA-Z\-\+\_\=!@$%^&*<>\.,/\\\|'`:\~\?][0-9a-zA-Z\-\+\_\=!@$%^&*<>\.,/\\\|'`:\~\?]*)(;[0-9a-zA-Z\-\+\_\=!@$%^&*<>\.,/\\\|'`:\~\?]+)?") +(def ^:private +ident-re+ #"^([a-zA-Z\-\+\_\=!@$%^&*<>\.,/\\\|'`:\~\?][0-9a-zA-Z\-\+\_\=!@$%^&*<>\.,/\\\|'`:\~\?]*)") ;; [Lexers] (def ^:private lex-white-space @@ -73,9 +74,9 @@ (return (&/V token)))) ^:private lex-bool "Bool" #"^(true|false)" - ^:private lex-real "Real" #"^-?(0|[1-9][0-9]*)\.[0-9]+" ^:private lex-int "Int" #"^-?(0|[1-9][0-9]*)" - ^:private lex-ident "Symbol" +ident-re+) + ^:private lex-real "Real" #"^-?(0|[1-9][0-9]*)\.[0-9]+" + ) (def ^:private lex-char (exec [_ (lex-prefix "#\"") @@ -91,10 +92,33 @@ _ (lex-prefix "\"")] (return (&/V "Text" token)))) +(def ^:private lex-ident + (&/try-all% (&/|list (exec [_ (lex-prefix ";") + token (lex-regex +ident-re+) + module-name &/get-module-name] + (return (&/T module-name token))) + (exec [token (lex-regex +ident-re+)] + (&/try-all% (&/|list (exec [_ (lex-prefix ";") + local-token (lex-regex +ident-re+)] + (&/try-all% (&/|list (exec [unaliased (&def/unalias-module token)] + (return (&/T unaliased local-token))) + (exec [? (&def/module-exists? token)] + (if ? + (return (&/T token local-token)) + (fail (str "[Lexer Error] Unknown module: " token)))) + ))) + (exec [module-name &/get-module-name] + (return (&/T module-name token)))))) + ))) + +(def ^:private lex-symbol + (exec [ident lex-ident] + (return (&/V "Symbol" ident)))) + (def ^:private lex-tag (exec [_ (lex-prefix "#") - token (lex-regex +ident-re+)] - (return (&/V "Tag" token)))) + ident lex-ident] + (return (&/V "Tag" ident)))) (do-template [ ] (def @@ -126,6 +150,6 @@ lex-int lex-char lex-text - lex-ident + lex-symbol lex-tag lex-delimiter))) diff --git a/src/lux/macro.clj b/src/lux/macro.clj index d31c22d78..7b612cbbb 100644 --- a/src/lux/macro.clj +++ b/src/lux/macro.clj @@ -7,6 +7,19 @@ (defn expand [loader macro-class tokens] (fn [state] ;; (prn 'expand macro-class tokens state) + ;; (let [expansion (-> (.loadClass loader macro-class) + ;; (.getField "_datum") + ;; (.get nil) + ;; (.apply tokens) + ;; (.apply state))] + ;; (matchv ::M/objects [expansion] + ;; [["lux;Right" [state* nodes]]] + ;; (doseq [node (&/->seq nodes)] + ;; (prn 'expansion macro-class (&/show-ast node))) + + ;; [_] + ;; nil) + ;; expansion) (-> (.loadClass loader macro-class) (.getField "_datum") (.get nil) diff --git a/src/lux/parser.clj b/src/lux/parser.clj index 56d8eb38f..1b0a44f91 100644 --- a/src/lux/parser.clj +++ b/src/lux/parser.clj @@ -17,8 +17,8 @@ [_] (fail (str "[Parser Error] Unbalanced " "."))))) - ^:private parse-form "Close_Paren" "parantheses" "Form" - ^:private parse-tuple "Close_Bracket" "brackets" "Tuple" + ^:private parse-form "Close_Paren" "parantheses" "lux;Form" + ^:private parse-tuple "Close_Bracket" "brackets" "lux;Tuple" ) (defn ^:private parse-record [parse] @@ -31,7 +31,7 @@ [_] (if (even? (&/|length elems)) - (return (&/|list (&/V "Record" (&/|as-pairs elems)))) + (return (&/|list (&/V "lux;Record" (&/|as-pairs elems)))) (fail (str "[Parser Error] Records must have an even number of elements.")))))) ;; [Interface] @@ -48,25 +48,25 @@ (return (&/|list)) [["Bool" ?value]] - (return (&/|list (&/V "Bool" (Boolean/parseBoolean ?value)))) + (return (&/|list (&/V "lux;Bool" (Boolean/parseBoolean ?value)))) [["Int" ?value]] - (return (&/|list (&/V "Int" (Integer/parseInt ?value)))) + (return (&/|list (&/V "lux;Int" (Integer/parseInt ?value)))) [["Real" ?value]] - (return (&/|list (&/V "Real" (Float/parseFloat ?value)))) + (return (&/|list (&/V "lux;Real" (Float/parseFloat ?value)))) [["Char" ?value]] - (return (&/|list (&/V "Char" (.charAt ?value 0)))) + (return (&/|list (&/V "lux;Char" (.charAt ?value 0)))) [["Text" ?value]] - (return (&/|list (&/V "Text" ?value))) + (return (&/|list (&/V "lux;Text" ?value))) - [["Symbol" ?value]] - (return (&/|list (&/V "Symbol" ?value))) + [["Symbol" ?ident]] + (return (&/|list (&/V "lux;Symbol" ?ident))) - [["Tag" ?value]] - (return (&/|list (&/V "Tag" ?value))) + [["Tag" ?ident]] + (return (&/|list (&/V "lux;Tag" ?ident))) [["Open_Paren" _]] (parse-form parse) diff --git a/src/lux/type.clj b/src/lux/type.clj index a142aba8e..68fb13b3d 100644 --- a/src/lux/type.clj +++ b/src/lux/type.clj @@ -9,20 +9,20 @@ (defn ^:private deref [id] (fn [state] - (if-let [type* (->> state (&/get$ "types") (&/get$ "mappings") (&/|get id))] + (if-let [type* (->> state (&/get$ "lux;types") (&/get$ "lux;mappings") (&/|get id))] (matchv ::M/objects [type*] - [["Some" type]] + [["lux;Some" type]] (return* state type) - [["None" _]] + [["lux;None" _]] (fail* (str "Unbound type-var: " id))) (fail* (str "Unknown type-var: " id))))) (defn ^:private reset [id type] (fn [state] - (if-let [_ (->> state (&/get$ "types") (&/get$ "mappings") (&/|get id))] - (return* (&/update$ "types" (fn [ts] (&/update$ "mappings" #(&/|put id (&/V "Some" type) %) - ts)) + (if-let [_ (->> state (&/get$ "lux;types") (&/get$ "lux;mappings") (&/|get id))] + (return* (&/update$ "lux;types" (fn [ts] (&/update$ "lux;mappings" #(&/|put id (&/V "lux;Some" type) %) + ts)) state) nil) (fail* (str "Unknown type-var: " id))))) @@ -30,64 +30,64 @@ ;; [Exports] (def fresh-var (fn [state] - (let [id (->> state (&/get$ "types") (&/get$ "counter"))] - (return* (&/update$ "types" #(->> % - (&/update$ "counter" inc) - (&/update$ "mappings" (fn [ms] (&/|put id (&/V "None" nil) ms)))) + (let [id (->> state (&/get$ "lux;types") (&/get$ "lux;counter"))] + (return* (&/update$ "lux;types" #(->> % + (&/update$ "lux;counter" inc) + (&/update$ "lux;mappings" (fn [ms] (&/|put id (&/V "lux;None" nil) ms)))) state) - (&/V "Var" id))))) + (&/V "lux;TVar" id))))) (def fresh-lambda (exec [=arg fresh-var =return fresh-var] - (return (&/V "Lambda" (to-array [=arg =return]))))) + (return (&/V "lux;TLambda" (&/T =arg =return))))) (defn ^:private ->type [pseudo-type] (match pseudo-type [::Any] - (&/V "Any" nil) + (&/V "lux;TAny" nil) [::Nothing] - (&/V "Nothing" nil) + (&/V "lux;TNothing" nil) [::Data ?name ?elems] - (&/V "Data" (to-array [?name ?elems])) + (&/V "lux;TData" (&/T ?name ?elems)) [::Tuple ?members] - (&/V "Tuple" (&/|map ->type ?members)) + (&/V "lux;TTuple" (&/|map ->type ?members)) [::Variant ?members] - (&/V "Variant" (&/|map (fn [[k v]] (to-array [k (->type v)])) - ?members)) + (&/V "lux;TVariant" (&/|map (fn [[k v]] (&/T k (->type v))) + ?members)) [::Record ?members] - (&/V "Record" (&/|map (fn [[k v]] (to-array [k (->type v)])) - ?members)) + (&/V "lux;TRecord" (&/|map (fn [[k v]] (&/T k (->type v))) + ?members)) [::Lambda ?input ?output] - (&/V "Lambda" (to-array [(->type ?input) (->type ?output)])) + (&/V "lux;TLambda" (&/T (->type ?input) (->type ?output))) [::App ?lambda ?param] - (&/V "App" (to-array [(->type ?lambda) (->type ?param)])) + (&/V "lux;TApp" (&/T (->type ?lambda) (->type ?param))) [::Bound ?name] - (&/V "Bound" ?name) + (&/V "lux;TBound" ?name) [::Var ?id] - (&/V "Var" ?id) + (&/V "lux;TVar" ?id) [::All ?env ?name ?arg ?body] - (&/V "All" (to-array [(&/|map (fn [[k v]] (to-array [k (->type v)])) - ?env) - ?name - ?arg - (->type ?body)])) + (&/V "lux;TAll" (&/T (&/|map (fn [[k v]] (&/T k (->type v))) + ?env) + ?name + ?arg + (->type ?body))) )) (def +list+ [::All (&/|list) "List" "a" - [::Variant (&/|list ["Cons" [::Tuple (&/|list [::Bound "a"] [::App [::Bound "List"] [::Bound "a"]])]] - ["Nil" [::Tuple (&/|list)]])]]) + [::Variant (&/|list ["lux;Cons" [::Tuple (&/|list [::Bound "a"] [::App [::Bound "List"] [::Bound "a"]])]] + ["lux;Nil" [::Tuple (&/|list)]])]]) (def +type+ (let [text [::Data "java.lang.String" (&/|list)] @@ -95,66 +95,66 @@ list-of-types [::App +list+ type] string=>type [::App +list+ [::Tuple (&/|list text type)]]] (->type [::All (&/|list) "Type" "_" - [::Variant (&/|list ["Any" [::Tuple (&/|list)]] - ["Nothing" [::Tuple (&/|list)]] - ["Data" [::Tuple (&/|list text list-of-types)]] - ["Tuple" list-of-types] - ["Variant" string=>type] - ["Record" string=>type] - ["Lambda" [::Tuple (&/|list type - type)]] - ["App" [::Tuple (&/|list type - type)]] - ["Bound" text] - ["Var" [::Data "java.lang.Long" (&/|list)]] - ["All" [::Tuple (&/|list string=>type text text type)]] + [::Variant (&/|list ["lux;TAny" [::Tuple (&/|list)]] + ["lux;TNothing" [::Tuple (&/|list)]] + ["lux;TData" [::Tuple (&/|list text list-of-types)]] + ["lux;TTuple" list-of-types] + ["lux;TVariant" string=>type] + ["lux;TRecord" string=>type] + ["lux;TLambda" [::Tuple (&/|list type + type)]] + ["lux;TApp" [::Tuple (&/|list type + type)]] + ["lux;TBound" text] + ["lux;TVar" [::Data "java.lang.Long" (&/|list)]] + ["lux;TAll" [::Tuple (&/|list string=>type text text type)]] )]]))) (defn clean [tvar type] (matchv ::M/objects [tvar] - [["Var" ?tid]] + [["lux;TVar" ?tid]] (matchv ::M/objects [type] - [["Var" ?id]] + [["lux;TVar" ?id]] (if (= ?tid ?id) (&/try-all% (&/|list (exec [=type (deref ?id)] (clean tvar =type)) (return type))) (return type)) - [["Lambda" [?arg ?return]]] + [["lux;TLambda" [?arg ?return]]] (exec [=arg (clean tvar ?arg) =return (clean tvar ?return)] - (return (&/V "Lambda" (to-array [=arg =return])))) + (return (&/V "lux;TLambda" (to-array [=arg =return])))) - [["App" [?lambda ?param]]] + [["lux;TApp" [?lambda ?param]]] (exec [=lambda (clean tvar ?lambda) =param (clean tvar ?param)] - (return (&/V "App" (to-array [=lambda =param])))) + (return (&/V "lux;TApp" (to-array [=lambda =param])))) - [["Tuple" ?members]] + [["lux;TTuple" ?members]] (exec [=members (&/map% (partial clean tvar) ?members)] - (return (&/V "Tuple" =members))) + (return (&/V "lux;TTuple" =members))) - [["Variant" ?members]] + [["lux;TVariant" ?members]] (exec [=members (&/map% (fn [[k v]] (exec [=v (clean tvar v)] (return (to-array [k =v])))) ?members)] - (return (&/V "Variant" =members))) + (return (&/V "lux;TVariant" =members))) - [["Record" ?members]] + [["lux;TRecord" ?members]] (exec [=members (&/map% (fn [[k v]] (exec [=v (clean tvar v)] (return (to-array [k =v])))) ?members)] - (return (&/V "Record" =members))) + (return (&/V "lux;TRecord" =members))) - [["All" [?env ?name ?arg ?body]]] + [["lux;TAll" [?env ?name ?arg ?body]]] (exec [=env (&/map% (fn [[k v]] (exec [=v (clean tvar v)] (return (to-array [k =v])))) ?env)] - (return (&/V "All" (to-array [=env ?name ?arg ?body])))) + (return (&/V "lux;TAll" (to-array [=env ?name ?arg ?body])))) [_] (return type) @@ -163,53 +163,53 @@ (defn show-type [type] (prn 'show-type (aget type 0)) (matchv ::M/objects [type] - [["Any" _]] + [["lux;TAny" _]] "Any" - [["Nothing" _]] + [["lux;TNothing" _]] "Nothing" - [["Data" [name params]]] + [["lux;TData" [name params]]] (str "(^ " name " [" (->> params (&/|map show-type) (&/|interpose " ") (&/fold str "")) "])") - [["Tuple" elems]] + [["lux;TTuple" elems]] (str "(, " (->> elems (&/|map show-type) (&/|interpose " ") (&/fold str "")) ")") - [["Variant" cases]] + [["lux;TVariant" cases]] (str "(| " (->> cases (&/|map (fn [kv] - (matchv ::M/objects [kv] - [[k ["Tuple" ["Nil" _]]]] - (str "#" k) + (matchv ::M/objects [kv] + [[k ["Tuple" ["Nil" _]]]] + (str "#" k) - [[k v]] - (str "(#" k " " (show-type v) ")")))) + [[k v]] + (str "(#" k " " (show-type v) ")")))) (&/|interpose " ") (&/fold str "")) ")") - [["Record" fields]] + [["lux;TRecord" fields]] (str "(& " (->> fields (&/|map (fn [kv] - (matchv ::M/objects [kv] - [[k v]] - (str "(#" k " " (show-type v) ")")))) + (matchv ::M/objects [kv] + [[k v]] + (str "(#" k " " (show-type v) ")")))) (&/|interpose " ") (&/fold str "")) ")") - [["Lambda" [input output]]] + [["lux;TLambda" [input output]]] (str "(-> " (show-type input) " " (show-type output) ")") - [["Var" id]] + [["lux;TVar" id]] (str "⌈" id "⌋") - [["Bound" name]] + [["lux;TBound" name]] name - [["App" [?lambda ?param]]] + [["lux;TApp" [?lambda ?param]]] (str "(" (show-type ?lambda) " " (show-type ?param) ")") - [["All" [?env ?name ?arg ?body]]] + [["lux;TAll" [?env ?name ?arg ?body]]] (str "(All " ?name " " ?arg " " (show-type ?body) ")") )) @@ -232,7 +232,7 @@ ;; (.isAssignableFrom (Class/forName e!name) (Class/forName a!name))) ;; success ;; (fail (str "not (" actual " <= " expected ")"))) - + ;; [["Tuple" e!elems] ["Tuple" a!elems]] ;; (exec [_ (assert! (= (&/|length e!elems) (&/|length a!elems)) ;; "Tuples must have matching element sizes.") @@ -280,16 +280,16 @@ (let [&& #(and %1 %2)] (defn merge [x y] (matchv ::M/objects [x y] - [_ ["Any" _]] + [_ ["lux;TAny" _]] (return y) - [["Any" _] _] + [["lux;TAny" _] _] (return x) - [_ ["Nothing" _]] + [_ ["lux;TNothing" _]] (return x) - [["Nothing" _] _] + [["lux;TNothing" _] _] (return y) ;;; @@ -324,22 +324,22 @@ (defn apply-lambda [func param] (matchv ::M/objects [func] - [["Lambda" [input output]]] + [["lux;TLambda" [input output]]] (exec [_ (solve input param)] (return output)) [_] - (return (&/V "Any" nil)) + (return (&/V "lux;TAny" nil)) ;; (fail (str "[Type System] Can't apply type " (str func) " to type " (str param))) )) (defn slot-type [record slot] (fn [state] (matchv ::M/objects [(&/|get record slot)] - [["Left" msg]] + [["lux;Left" msg]] (fail* msg) - [["Right" type]] + [["lux;Right" type]] (return* state type)))) -(def +dont-care+ (&/V "Any" nil)) +(def +dont-care+ (&/V "lux;TAny" nil)) -- cgit v1.2.3