diff options
| author | Eduardo Julian | 2015-04-19 19:50:10 -0400 |
|---|---|---|
| committer | Eduardo Julian | 2015-04-19 19:50:10 -0400 |
| commit | e1df2642c538293f1dfd0faffad72b48a626148a (patch) | |
| tree | ba62cd4c50b193a8c147957f7ca6339f16dd1ff3 | |
| parent | 6676e1bb8e79ed4336b113b573f3b9f9dd8399af (diff) | |
- Fixed several bugs in lux.lux
- Fixed an error in lux.base/analyse-2
- Modified the analyser so the symbols that identify all of the special forms must mandatorily have "" as their prefix.
- Fixed a bug in the binary operations at lux.analyser.host wherein the types where being omitted.
- Fixed a bug when closing-over variables inside lambda bodies wherein the names of bindings where being stores as (incomparable) arrays, instead of as (comparable) strings.
Diffstat (limited to '')
| -rw-r--r-- | source/lux.lux | 2346 | ||||
| -rw-r--r-- | src/lux/analyser.clj | 168 | ||||
| -rw-r--r-- | src/lux/analyser/base.clj | 23 | ||||
| -rw-r--r-- | src/lux/analyser/case.clj | 210 | ||||
| -rw-r--r-- | src/lux/analyser/host.clj | 6 | ||||
| -rw-r--r-- | src/lux/analyser/lambda.clj | 18 | ||||
| -rw-r--r-- | src/lux/analyser/lux.clj | 122 | ||||
| -rw-r--r-- | src/lux/compiler.clj | 2 | ||||
| -rw-r--r-- | src/lux/compiler/case.clj | 2 | ||||
| -rw-r--r-- | src/lux/compiler/lambda.clj | 3 | ||||
| -rw-r--r-- | src/lux/type.clj | 26 |
11 files changed, 1565 insertions, 1361 deletions
diff --git a/source/lux.lux b/source/lux.lux index a08c88db7..b03de7473 100644 --- a/source/lux.lux +++ b/source/lux.lux @@ -25,6 +25,7 @@ ## Basic types (def' Any #AnyT) +(def' Nothing #NothingT) (def' Bool (#DataT "java.lang.Boolean")) (def' Int (#DataT "java.lang.Long")) (def' Real (#DataT "java.lang.Double")) @@ -163,6 +164,15 @@ (#Cons [["lux;eval-ctor" Int] #Nil])])])])])])])])])))) +## (deftype (Syntax' f) +## (f (| (#Bool Bool) +## (#Int Int) +## (#Real Real) +## (#Char Char) +## (#Text Text) +## (#Form (List (Syntax' f))) +## (#Tuple (List (Syntax' f))) +## (#Record (List (, Text (Syntax' f))))))) ## (deftype #rec Syntax ## (Meta Cursor (| (#Bool Bool) ## (#Int Int) @@ -172,24 +182,69 @@ ## (#Form (List Syntax)) ## (#Tuple (List Syntax)) ## (#Record (List (, Text Syntax)))))) +## (deftype (Syntax' w) +## (| (#Bool Bool) +## (#Int Int) +## (#Real Real) +## (#Char Char) +## (#Text Text) +## (#Symbol (, Text Text)) +## (#Tag (, Text Text)) +## (#Form (List (w (Syntax' w)))) +## (#Tuple (List (w (Syntax' w)))) +## (#Record (List (, Text (w (Syntax' w))))))) +(def' Syntax' + (check' Type + (case' (#AppT [(#BoundT "w") + (#AppT [(#BoundT "Syntax'") + (#BoundT "w")])]) + Syntax' + (case' (#AppT [List Syntax']) + Syntax'List + (case' (#TupleT (#Cons [Text (#Cons [Text #Nil])])) + Ident + (#AllT [#Nil "Syntax'" "w" + (#VariantT (#Cons [["lux;Bool" Bool] + (#Cons [["lux;Int" Int] + (#Cons [["lux;Real" Real] + (#Cons [["lux;Char" Char] + (#Cons [["lux;Text" Text] + (#Cons [["lux;Symbol" Ident] + (#Cons [["lux;Tag" Ident] + (#Cons [["lux;Form" Syntax'List] + (#Cons [["lux;Tuple" Syntax'List] + (#Cons [["lux;Record" (#AppT [List (#TupleT (#Cons [Text (#Cons [Syntax' #Nil])]))])] + #Nil]) + ])])])])])])])])]) + )]) + ))))) + +## (deftype Syntax +## (Meta Cursor (Syntax' (Meta Cursor)))) (def' Syntax (check' Type - (case' (#AppT [(#BoundT "Syntax") (#BoundT "")]) - Syntax - (case' (#AppT [List Syntax]) - SyntaxList - (#AppT [(#AllT [#Nil "Syntax" "" - (#AppT [(#AppT [Meta Cursor]) - (#VariantT (#Cons [["lux;Bool" Bool] - (#Cons [["lux;Int" Int] - (#Cons [["lux;Real" Real] - (#Cons [["lux;Char" Char] - (#Cons [["lux;Text" Text] - (#Cons [["lux;Form" SyntaxList] - (#Cons [["lux;Tuple" SyntaxList] - (#Cons [["lux;Record" (#AppT [List (#TupleT (#Cons [Text (#Cons [Syntax #Nil])]))])] - #Nil])])])])])])])]))])]) - #NothingT]))))) + (case' (#AppT [Meta Cursor]) + w + (#AppT [w (#AppT [Syntax' w])])))) + +## (def' Syntax +## (check' Type +## (case' (#AppT [(#BoundT "Syntax") (#BoundT "")]) +## Syntax +## (case' (#AppT [List Syntax]) +## SyntaxList +## (#AppT [(#AllT [#Nil "Syntax" "" +## (#AppT [(#AppT [Meta Cursor]) +## (#VariantT (#Cons [["lux;Bool" Bool] +## (#Cons [["lux;Int" Int] +## (#Cons [["lux;Real" Real] +## (#Cons [["lux;Char" Char] +## (#Cons [["lux;Text" Text] +## (#Cons [["lux;Form" SyntaxList] +## (#Cons [["lux;Tuple" SyntaxList] +## (#Cons [["lux;Record" (#AppT [List (#TupleT (#Cons [Text (#Cons [Syntax #Nil])]))])] +## #Nil])])])])])])])]))])]) +## #NothingT]))))) ## (deftype (Either l r) ## (| (#Left l) @@ -202,6 +257,16 @@ (#Cons [["lux;Right" (#BoundT "r")] #Nil])]))])]))) +## (deftype MacroOutput +## (Either Text [CompilerState (List Syntax)])) +## (def' MacroOutput +## (check' Type +## (case' (#AppT [List Syntax]) +## SyntaxList +## (#AppT [(#AppT [Either Text]) +## (#TupleT (#Cons [CompilerState +## (#Cons [SyntaxList #Nil])]))])))) + ## (deftype Macro ## (-> (List Syntax) CompilerState ## (Either Text [CompilerState (List Syntax)]))) @@ -213,1093 +278,1198 @@ (#LambdaT [CompilerState (#AppT [(#AppT [Either Text]) (#TupleT (#Cons [CompilerState - (#Cons [SyntaxList #Nil])]))])])])))) + (#Cons [SyntaxList + #Nil])]))])])])))) ## Base functions & macros ## (def (_meta data) -## (All [a] (-> a (Meta Cursor a))) +## (-> (Syntax' (Meta Cursor)) Syntax) ## (#Meta [["" -1 -1] data])) (def' _meta - (check' (#AllT [#Nil "_" "a" - (#LambdaT [(#BoundT "a") - (#AppT [(#AppT [Meta Cursor]) - (#BoundT "a")])])]) + (check' (#LambdaT [(#AppT [Syntax' + (#AppT [Meta Cursor])]) + Syntax]) (lambda' _ data (#Meta [["" -1 -1] data])))) -## (def' let' -## (check' Macro -## (lambda' _ tokens -## (lambda' _ state -## (case' tokens -## (#Cons [lhs (#Cons [rhs (#Cons [body #Nil])])]) -## (#Right [state -## (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "case'"])) -## (#Cons [rhs (#Cons [lhs (#Cons [body #Nil])])])]))) -## #Nil])]) - -## _ -## (#Left "Wrong syntax for let'")) -## )))) +## (def (return' x) +## (-> SyntaxList CompilerState +## (Either Text (, CompilerState SyntaxList))) +## ...) +(def' return' + (check' (case' (#AppT [List Syntax]) + SyntaxList + (#LambdaT [SyntaxList + (#LambdaT [CompilerState + (#AppT [(#AppT [Either Text]) + (#TupleT (#Cons [CompilerState + (#Cons [SyntaxList + #Nil])]))])])])) + (lambda' _ val + (lambda' _ state + (#Right [state val]))))) + +## (def (fail' msg) +## (-> Text CompilerState +## (Either Text (, CompilerState SyntaxList))) +## ...) +(def' fail' + (check' (case' (#AppT [List Syntax]) + SyntaxList + (#LambdaT [Text + (#LambdaT [CompilerState + (#AppT [(#AppT [Either Text]) + (#TupleT (#Cons [CompilerState + (#Cons [SyntaxList + #Nil])]))])])])) + (lambda' _ msg + (lambda' _ state + (#Left msg))))) ## (def' let' ## (check' Macro ## (lambda' _ tokens -## (lambda' _ state -## (#Left "Wrong syntax for let'") -## )))) +## (case' tokens +## (#Cons [lhs (#Cons [rhs (#Cons [body #Nil])])]) +## (return' (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "case'"])) +## (#Cons [rhs (#Cons [lhs (#Cons [body #Nil])])])]))) +## #Nil])) + +## _ +## (#Left "Wrong syntax for let'"))))) +(def' let' + (check' Macro + (lambda' _ tokens + (case' tokens + (#Cons [lhs (#Cons [rhs (#Cons [body #Nil])])]) + (return' (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "case'"])) + (#Cons [rhs (#Cons [lhs (#Cons [body #Nil])])])]))) + #Nil])) + + _ + (fail' "Wrong syntax for let'"))))) +(declare-macro' let') + +(def' lambda + (check' Macro + (lambda' _ tokens + (case' tokens + (#Cons [(#Meta [_ (#Tuple (#Cons [arg args']))]) (#Cons [body #Nil])]) + (return' (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "lambda'"])) + (#Cons [(_meta (#Symbol ["" ""])) + (#Cons [arg + (#Cons [(case' args' + #Nil + body + + _ + (_meta (#Form (#Cons [(_meta (#Symbol ["lux" "lambda"])) + (#Cons [(_meta (#Tuple args')) + (#Cons [body #Nil])])])))) + #Nil])])])]))) + #Nil])) + + (#Cons [(#Meta [_ (#Symbol self)]) (#Cons [(#Meta [_ (#Tuple (#Cons [arg args']))]) (#Cons [body #Nil])])]) + (return' (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "lambda'"])) + (#Cons [(_meta (#Symbol self)) + (#Cons [arg + (#Cons [(case' args' + #Nil + body + + _ + (_meta (#Form (#Cons [(_meta (#Symbol ["lux" "lambda"])) + (#Cons [(_meta (#Tuple args')) + (#Cons [body #Nil])])])))) + #Nil])])])]))) + #Nil])) + + _ + (fail' "Wrong syntax for lambda"))))) +(declare-macro' lambda) + +(def' def + (check' Macro + (lambda [tokens] + (case' tokens + (#Cons [(#Meta [_ (#Symbol name)]) (#Cons [body #Nil])]) + (return' (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "def'"])) tokens]))) + #Nil])) + + (#Cons [(#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol name)]) args]))]) + (#Cons [body #Nil])]) + (return' (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "def'"])) + (#Cons [(_meta (#Symbol name)) + (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "lambda"])) + (#Cons [(_meta (#Symbol name)) + (#Cons [(_meta (#Tuple args)) + (#Cons [body #Nil])])])]))) + #Nil])])]))) + #Nil])) + + (#Cons [(#Meta [_ (#Symbol name)]) (#Cons [type (#Cons [body #Nil])])]) + (return' (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "def'"])) + (#Cons [(_meta (#Symbol name)) + (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "check'"])) + (#Cons [type + (#Cons [body + #Nil])])]))) + #Nil])])]))) + #Nil])) + + (#Cons [(#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol name)]) args]))]) + (#Cons [type (#Cons [body #Nil])])]) + (return' (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "def'"])) + (#Cons [(_meta (#Symbol name)) + (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "check'"])) + (#Cons [type + (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "lambda"])) + (#Cons [(_meta (#Symbol name)) + (#Cons [(_meta (#Tuple args)) + (#Cons [body #Nil])])])]))) + #Nil])])]))) + #Nil])])]))) + #Nil])) + + _ + (fail' "Wrong syntax for def") + )))) +(declare-macro' def) + +(def (defmacro tokens) + Macro + (case' tokens + (#Cons [(#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol fn-name)]) args]))]) + (#Cons [body #Nil])]) + (return' (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "def"])) + (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol fn-name)) args]))) + (#Cons [(_meta (#Symbol ["lux" "Macro"])) + (#Cons [body + #Nil])]) + ])]))) + (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "declare-macro'"])) (#Cons [(_meta (#Symbol fn-name)) #Nil])]))) + #Nil])])) + + _ + (fail' "Wrong syntax for defmacro"))) +(declare-macro' defmacro) + +(defmacro (comment tokens) + (return' #Nil)) + +(defmacro (->' tokens) + (case' tokens + (#Cons [input (#Cons [output #Nil])]) + (return' (#Cons [(_meta (#Form (#Cons [(_meta (#Tag ["lux" "LambdaT"])) + (#Cons [(_meta (#Tuple (#Cons [input (#Cons [output #Nil])]))) + #Nil])]))) + #Nil])) + + (#Cons [input (#Cons [output others])]) + (return' (#Cons [(_meta (#Form (#Cons [(_meta (#Tag ["lux" "LambdaT"])) + (#Cons [(_meta (#Tuple (#Cons [input + (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "->'"])) + (#Cons [output others])]))) + #Nil])]))) + #Nil])]))) + #Nil])) + + _ + (fail' "Wrong syntax for ->'"))) + +(def (int+ x y) + (->' Int Int Int) + (jvm-ladd x y)) + +(defmacro (All' tokens) + (case' tokens + (#Cons [(#Meta [_ (#Tuple #Nil)]) + (#Cons [body #Nil])]) + (return' (#Cons [body + #Nil])) + + (#Cons [(#Meta [_ (#Tuple (#Cons [(#Meta [_ (#Symbol ["" arg-name])]) other-args]))]) + (#Cons [body #Nil])]) + (return' (#Cons [(_meta (#Form (#Cons [(_meta (#Tag ["lux" "AllT"])) + (#Cons [(_meta (#Tuple (#Cons [(_meta (#Tag ["lux" "Nil"])) + (#Cons [(_meta (#Text "")) + (#Cons [(_meta (#Text arg-name)) + (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "All'"])) + (#Cons [(_meta (#Tuple other-args)) + (#Cons [body + #Nil])])]))) + #Nil])])])]))) + #Nil])]))) + #Nil])) + + _ + (fail' "Wrong syntax for All'"))) + +(defmacro (B' tokens) + (case' tokens + (#Cons [(#Meta [_ (#Symbol ["" bound-name])]) + #Nil]) + (return' (#Cons [(_meta (#Form (#Cons [(_meta (#Tag ["lux" "BoundT"])) + (#Cons [(_meta (#Text bound-name)) + #Nil])]))) + #Nil])) + + _ + (fail' "Wrong syntax for B'"))) + +(defmacro ($' tokens) + (case' tokens + (#Cons [x #Nil]) + (return' tokens) + + (#Cons [x (#Cons [y xs])]) + (return' (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "$'"])) + (#Cons [(_meta (#Form (#Cons [(_meta (#Tag ["lux" "AppT"])) + (#Cons [(_meta (#Tuple (#Cons [x (#Cons [y #Nil])]))) + #Nil])]))) + xs])]))) + #Nil])) + + _ + (fail' "Wrong syntax for $'"))) + +(def (id x) + (All' [a] (->' (B' a) (B' a))) + x) + +(def (fold' f init xs) + (All' [a b] + (->' (->' (B' a) (B' b) (B' a)) + (B' a) + ($' List (B' b)) + (B' a))) + (case' xs + #Nil + init + + (#Cons [x xs']) + (fold' f (f init x) xs'))) + +(def (reverse' list) + (->' ($' List Syntax) ($' List Syntax)) + (fold' (check' (->' ($' List Syntax) Syntax + ($' List Syntax)) + (lambda [tail head] + (#Cons [head tail]))) + #Nil + list)) + +(defmacro (list xs) + (return' (#Cons [(fold' (check' (->' Syntax Syntax Syntax) + (lambda [tail head] + (_meta (#Form (#Cons [(_meta (#Tag ["lux" "Cons"])) + (#Cons [(_meta (#Tuple (#Cons [head (#Cons [tail #Nil])]))) + #Nil])]))))) + (_meta (#Tag ["lux" "Nil"])) + (reverse' xs)) + #Nil]))) + +(defmacro (list& xs) + (case' (reverse' xs) + (#Cons [last init]) + (return' (list (fold' (check' (->' Syntax Syntax Syntax) + (lambda [tail head] + (_meta (#Form (list (_meta (#Tag ["lux" "Cons"])) + (_meta (#Tuple (list head tail)))))))) + last + init))) + + _ + (fail' "Wrong syntax for list&"))) + +## (def (as-pairs xs) +## (All [a] +## (-> (List a) (List [a a]))) +## (case' xs +## (#Cons [x (#Cons [y xs'])]) +## (#Cons [[x y] (as-pairs xs')]) + +## _ +## #Nil)) + +## (defmacro (let tokens state) +## (case' tokens +## (#Cons [(#Meta [_ (#Tuple bindings)]) (#Cons [body #Nil])]) +## (let' output (fold (lambda [body binding] +## (case' binding +## [label value] +## (_meta (#Form (list (_meta (#Symbol ["lux" "let'"])) label value body))))) +## body +## (reverse (as-pairs bindings))) +## (#Right [state (list output)])))) + +## (def (print x) +## (-> (^ java.lang.Object) []) +## (jvm-invokevirtual java.io.PrintStream "print" [java.lang.Object] +## (jvm-getstatic java.lang.System "out") [x])) + +## (def (println x) +## (-> (^ java.lang.Object) []) +## (jvm-invokevirtual java.io.PrintStream "println" [java.lang.Object] +## (jvm-getstatic java.lang.System "out") [x])) + +## (deftype (IO a) +## (-> (,) a)) + +## (defmacro (io tokens) +## (case' tokens +## (#Cons [value #Nil]) +## (return (list (` (lambda [_] (~ value))))))) + +## (def (. f g) +## (All [a b c] +## (-> (-> b c) (-> a b) (-> a c))) +## (lambda [x] (f (g x)))) + +## (def (++ xs ys) +## (All [a] +## (-> (List a) (List a) (List a))) +## (case' xs +## #Nil +## ys + +## (#Cons [x xs']) +## (#Cons [x (++ xs' ys)]))) + +## (def concat +## (All [a] +## (-> (List (List a)) (List a))) +## (fold ++ #Nil)) + +## (def (map f xs) +## (All [a b] +## (-> (-> a b) (List a) (List b))) +## (case' xs +## #Nil +## #Nil + +## (#Cons [x xs']) +## (#Cons [(f x) (map f xs')]))) + +## (def flat-map +## (All [a b] +## (-> (-> a (List b)) (List a) (List b))) +## (. concat map)) + +## (def (wrap-meta content) +## ... +## (_meta (#Form (list (_meta (#Tag ["lux" "Meta"])) +## (_meta (#Tuple (list (_meta (#Tuple (list (_meta (#Form (list (_meta (#Tag ["lux" "Text"])) (_meta (#Text ""))))) +## (_meta (#Form (list (_meta (#Tag ["lux" "Int"])) (_meta (#Int -1))))) +## (_meta (#Form (list (_meta (#Tag ["lux" "Int"])) (_meta (#Int -1)))))))) +## (_meta content)))))))) + +## (def (untemplate-list tokens) +## (-> (List Syntax) Syntax) +## (case' tokens +## #Nil +## (_meta (#Tag ["lux" "Nil"])) + +## (#Cons [token tokens']) +## (_meta (#Form (list (_meta (#Tag ["lux" "Cons"])) +## (_meta (#Tuple (list token (untemplate-list tokens'))))))))) + +## (def (untemplate token) +## ... +## (case' token +## (#Meta [_ (#Bool value)]) +## (wrap-meta (#Form (list (_meta (#Tag ["lux" "Bool"])) (_meta (#Bool value))))) + +## (#Meta [_ (#Int value)]) +## (wrap-meta (#Form (list (_meta (#Tag ["lux" "Int"])) (_meta (#Int value))))) + +## (#Meta [_ (#Real value)]) +## (wrap-meta (#Form (list (_meta (#Tag ["lux" "Real"])) (_meta (#Real value))))) + +## (#Meta [_ (#Char value)]) +## (wrap-meta (#Form (list (_meta (#Tag ["lux" "Char"])) (_meta (#Char value))))) + +## (#Meta [_ (#Text value)]) +## (wrap-meta (#Form (list (_meta (#Tag ["lux" "Text"])) (_meta (#Text value))))) + +## (#Meta [_ (#Tag [module name])]) +## (wrap-meta (#Form (list (_meta (#Tag ["lux" "Tag"])) (_meta (#Tuple (list (_meta (#Text module)) (_meta (#Text name)))))))) + +## (#Meta [_ (#Symbol [module name])]) +## (wrap-meta (#Form (list (_meta (#Tag ["lux" "Symbol"])) (_meta (#Tuple (list (_meta (#Text module)) (_meta (#Text name)))))))) + +## (#Meta [_ (#Tuple elems)]) +## (wrap-meta (#Form (list (_meta (#Tag ["lux" "Tuple"])) (untemplate-list (map untemplate elems))))) + +## (#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol [_ "~"])]) (#Cons [(#Meta [_ unquoted]) #Nil])]))]) +## (_meta unquoted) + +## (#Meta [_ (#Form elems)]) +## (wrap-meta (#Form (list (_meta (#Tag ["lux" "Form"])) (untemplate-list (map untemplate elems))))) +## )) + +(defmacro (` tokens) + (case' tokens + (#Cons [template #Nil]) + (return' (list (untemplate template))))) + +(defmacro (if tokens) + (case' tokens + (#Cons [test (#Cons [then (#Cons [else #Nil])])]) + (return' (list (` (case' (~ test) + true (~ then) + false (~ else))))))) + +## (def (filter p xs) +## (All [a] +## (-> (-> a Bool) (List a) (List a))) +## (case' xs +## #Nil +## #Nil + +## (#Cons [x xs']) +## (if (p x) +## (#Cons [x (filter p xs')]) +## (filter p xs')))) + +## (deftype (LuxStateM a) +## (-> CompilerState (Either Text [CompilerState a]))) + +## (def (return val) +## (All [a] +## (-> a (LuxStateM a))) +## (lambda [state] +## (#Right [state val]))) + +## (def (fail msg) +## (-> Text (LuxStateM Nothing)) +## (lambda [_] +## (#Left msg))) + +## (def (bind f v) +## (All [m a b] (-> (-> a (m b)) (m a) (m b))) +## (lambda [state] +## (case' (v state) +## (#Right [state' x]) +## (f x state') + +## (#Left msg) +## (#Left msg)))) + +## (def (first pair) +## (All [a b] (-> (, a b) a)) +## (case' pair +## [f s] +## f)) + +## (def (second pair) +## (All [a b] (-> (, a b) b)) +## (case' pair +## [f s] +## s)) + +## (defmacro (loop tokens) +## (case' tokens +## (#Cons [bindings (#Cons [body #Nil])]) +## (let [pairs (as-pairs bindings)] +## (return (list (#Form (#Cons [(` (lambda (~ (#Symbol ["lux" "recur"])) (~ (#Tuple (map first pairs))) +## (~ body))) +## (map second pairs)]))))))) + +## (defmacro (export tokens) +## (return (map (lambda [t] (` (export' (~ t)))) +## tokens))) + +## (defmacro (and tokens) +## (let [as-if (case' tokens +## #Nil +## (` true) + +## (#Cons [init tests]) +## (fold (lambda [prev next] +## (` (if (~ prev) (~ next) false))) +## init +## tokens) +## )] +## (return (list as-if)))) + +## (defmacro (or tokens) +## (let [as-if (case' tokens +## #Nil +## (` false) + +## (#Cons [init tests]) +## (fold (lambda [prev next] +## (` (if (~ prev) true (~ next)))) +## init +## tokens) +## )] +## (return (list as-if)))) + +## (def (not x) +## (-> Bool Bool) +## (case' x +## true false +## false true)) + +## (defmacro (|> tokens) +## (case' tokens +## (#Cons [init apps]) +## (return (list (fold (lambda [acc app] +## (case' app +## (#Form parts) +## (#Form (++ parts (list acc))) + +## _ +## (` ((~ app) (~ acc))))) +## init +## apps))))) + +## (defmacro ($ tokens) +## (case' tokens +## (#Cons [op (#Cons [init args])]) +## (return (list (fold (lambda [acc elem] +## (` ((~ op) (~ acc) (~ elem)))) +## init +## args))))) + +## (def (const x) +## (All [a] +## (-> a (-> Any a))) +## (lambda [_] +## x)) + +## (def (int> x y) +## (-> Int Int Bool) +## (jvm-lgt x y)) + +## (def (int< x y) +## (-> Int Int Bool) +## (jvm-llt x y)) + +## (def inc +## (-> Int Int) +## (int+ 1)) + +## (def dec +## (-> Int Int) +## (int+ -1)) + +## (def (repeat n x) +## (All [a] (-> Int a (List a))) +## (if (int> n 0) +## (#Cons [x (repeat (dec n) x)]) +## #Nil)) + +## (def size +## (All [a] +## (-> (List a) Int)) +## (fold (lambda [acc _] (inc acc)) 0)) + +## (def (last xs) +## (All [a] +## (-> (List a) (Maybe a))) +## (case' xs +## #Nil #None +## (#Cons [x #Nil]) (#Some x) +## (#Cons [_ xs']) (last xs'))) + +## (def (init xs) +## (All [a] +## (-> (List a) (Maybe (List a)))) +## (case' xs +## #Nil #None +## (#Cons [_ #Nil]) (#Some #Nil) +## (#Cons [x xs']) (case' (init xs') +## (#Some xs'') +## (#Some (#Cons [x xs''])) + +## _ +## (#Some (#Cons [x #Nil]))))) + +## (defmacro (cond tokens) +## (case' (reverse tokens) +## (#Cons [else branches']) +## (return (list (fold (lambda [else branch] +## (case' branch +## [test then] +## (` (if (~ test) (~ then) (~ else))))) +## else +## (|> branches' reverse as-pairs)))))) + +## (def (interleave xs ys) +## (All [a] +## (-> (List a) (List a) (List a))) +## (case' [xs ys] +## [(#Cons [x xs']) (#Cons [y ys'])] +## (list+ x y (interleave xs' ys')) + +## _ +## #Nil)) + +## (def (interpose sep xs) +## (All [a] +## (-> a (List a) (List a))) +## (case' xs +## #Nil +## xs + +## (#Cons [x #Nil]) +## xs + +## (#Cons [x xs']) +## (list+ x sep (interpose sep xs')))) + +## (def (empty? xs) +## (All [a] +## (-> (List a) Bool)) +## (case' xs +## #Nil true +## _ false)) + +## ## ## ## (do-template [<name> <op>] +## ## ## ## (def (<name> p xs) +## ## ## ## (case xs +## ## ## ## #Nil true +## ## ## ## (#Cons [x xs']) (<op> (p x) (<name> p xs')))) + +## ## ## ## [every? and] +## ## ## ## [any? or]) + +## (def (range from to) +## (-> Int Int (List Int)) +## (if (int< from to) +## (#Cons [from (range (inc from) to)]) +## #Nil)) + +## (def (tuple->list tuple) +## (-> Syntax (List Syntax)) +## (case' tuple +## (#Meta [_ (#Tuple list)]) +## list)) + +## (def (zip2 xs ys) +## (All [a b] +## (-> (List a) (List b) (List (, a b)))) +## (case' [xs ys] +## [(#Cons [x xs']) (#Cons [y ys'])] +## (#Cons [[x y] (zip2 xs' ys')]) + +## _ +## #Nil)) + +## (def (get key map) +## (All [a b] +## (-> a (List (, a b)) (Maybe b))) +## (case' map +## #Nil +## #None + +## (#Cons [[k v] map']) +## (if (jvm-invokevirtual java.lang.Object "equals" [java.lang.Object] +## k [key]) +## (#Some v) +## (get key map')))) + +## (def (get-ident x) +## (-> Syntax Text) +## (case' x +## (#Meta [_ (#Symbol [_ ident])]) +## ident)) + +## (def (text-++ x y) +## (-> Text Text Text) +## (jvm-invokevirtual java.lang.String "concat" [java.lang.String] +## x [y])) + +## (def (show-env env) +## ... +## (|> env (map first) (interpose ", ") (fold text-++ ""))) + +## (def (apply-template env template) +## (case' template +## (#Meta [_ (#Symbol [_ ident])]) +## (case' (get ident env) +## (#Some subst) +## subst + +## _ +## template) + +## (#Meta [_ (#Tuple elems)]) +## (_meta (#Tuple (map (apply-template env) elems))) + +## (#Meta [_ (#Form elems)]) +## (_meta (#Form (map (apply-template env) elems))) + +## (#Meta [_ (#Record members)]) +## (_meta (#Record (map (lambda [kv] +## (case' kv +## [slot value] +## [(apply-template env slot) (apply-template env value)])) +## members))) + +## _ +## template)) + +## (defmacro (do-templates tokens) +## (case' tokens +## (#Cons [bindings (#Cons [(#Meta [_ (#Tuple templates)]) data])]) +## (let [bindings-list (map get-ident (tuple->list bindings)) +## data-lists (map tuple->list data) +## apply (lambda [env] (map (apply-template env) templates))] +## (|> data-lists +## (map (. apply (zip2 bindings-list))) +## return)))) + +## ## ## ## (do-template [<name> <offset>] +## ## ## ## (def <name> (int+ <offset>)) + +## ## ## ## [inc 1] +## ## ## ## [dec -1]) + +## (def (int= x y) +## (-> Int Int Bool) +## (jvm-leq x y)) + +## (def (int% x y) +## (-> Int Int Int) +## (jvm-lrem x y)) + +## (def (int>= x y) +## (-> Int Int Bool) +## (or (int= x y) +## (int> x y))) + +## (do-templates [<name> <cmp>] +## [(def (<name> x y) +## (-> Int Int Int) +## (if (<cmp> x y) +## x +## y))] + +## [max int>] +## [min int<]) + +## (do-templates [<name> <cmp>] +## [(def (<name> n) +## (-> Int Bool) +## (<cmp> n 0))] + +## [neg? int<] +## [pos? int>=]) + +## (def (even? n) +## (-> Int Bool) +## (int= 0 (int% n 0))) + +## (def (odd? n) +## (-> Int Bool) +## (not (even? n))) + +## (do-templates [<name> <done> <step>] +## [(def (<name> n xs) +## (All [a] +## (-> Int (List a) (List a))) +## (if (int> n 0) +## (case' xs +## #Nil #Nil +## (#Cons [x xs']) <step>) +## <done>))] + +## [take #Nil (list+ x (take (dec n) xs'))] +## [drop xs (drop (dec n) xs')]) + +## (do-templates [<name> <done> <step>] +## [(def (<name> f xs) +## (All [a] +## (-> (-> a Bool) (List a) (List a))) +## (case' xs +## #Nil #Nil +## (#Cons [x xs']) (if (f x) <step> #Nil)))] + +## [take-while #Nil (list+ x (take-while f xs'))] +## [drop-while xs (drop-while f xs')]) + +## ## (defmacro (get@ tokens) +## ## (let [output (case' tokens +## ## (#Cons [tag (#Cons [record #Nil])]) +## ## (` (get@' (~ tag) (~ record))) + +## ## (#Cons [tag #Nil]) +## ## (` (lambda [record] (get@' (~ tag) record))))] +## ## (return (list output)))) + +## ## (defmacro (set@ tokens) +## ## (let [output (case' tokens +## ## (#Cons [tag (#Cons [value (#Cons [record #Nil])])]) +## ## (` (set@' (~ tag) (~ value) (~ record))) + +## ## (#Cons [tag (#Cons [value #Nil])]) +## ## (` (lambda [record] (set@' (~ tag) (~ value) record))) + +## ## (#Cons [tag #Nil]) +## ## (` (lambda [value record] (set@' (~ tag) value record))))] +## ## (return (list output)))) + +## ## (defmacro (update@ tokens) +## ## (let [output (case' tokens +## ## (#Cons [tag (#Cons [func (#Cons [record #Nil])])]) +## ## (` (let [_record_ (~ record)] +## ## (set@' (~ tag) ((~ func) (get@' (~ tag) _record_)) _record_))) + +## ## (#Cons [tag (#Cons [func #Nil])]) +## ## (` (lambda [record] +## ## (` (set@' (~ tag) ((~ func) (get@' (~ tag) record)) record)))) + +## ## (#Cons [tag #Nil]) +## ## (` (lambda [func record] +## ## (set@' (~ tag) (func (get@' (~ tag) record)) record))))] +## ## (return (list output)))) + +## (def (show-int int) +## (-> Int Text) +## (jvm-invokevirtual java.lang.Object "toString" [] +## int [])) + +## (def gensym +## (LuxStateM Syntax) +## (lambda [state] +## [(update@ [#gen-seed] inc state) +## (_meta (#Symbol ($ text-++ "__" (show-int (get@ [#gen-seed] state)) "__")))])) + +## ## (do-template [<name> <member>] +## ## (def (<name> pair) +## ## (case' pair +## ## [f s] +## ## <member>)) + +## ## [first f] +## ## [second s]) + +## (def (show-syntax syntax) +## (-> Syntax Text) +## (case' syntax +## (#Meta [_ (#Bool value)]) +## (jvm-invokevirtual java.lang.Object "toString" [] +## value []) + +## (#Meta [_ (#Int value)]) +## (jvm-invokevirtual java.lang.Object "toString" [] +## value []) + +## (#Meta [_ (#Real value)]) +## (jvm-invokevirtual java.lang.Object "toString" [] +## value []) + +## (#Meta [_ (#Char value)]) +## (jvm-invokevirtual java.lang.Object "toString" [] +## value []) + +## (#Meta [_ (#Text value)]) +## (jvm-invokevirtual java.lang.Object "toString" [] +## value []) + +## (#Meta [_ (#Symbol [module name])]) +## ($ text-++ module ";" name) + +## (#Meta [_ (#Tag [module name])]) +## ($ text-++ "#" module ";" name) + +## (#Meta [_ (#Tuple members)]) +## ($ text-++ "[" (fold text-++ "" (interpose " " (map show-syntax members))) "]") + +## (#Meta [_ (#Form members)]) +## ($ text-++ "(" (fold text-++ "" (interpose " " (map show-syntax members))) ")") +## )) + +## (defmacro (do tokens) +## (case' tokens +## (#Cons [(#Meta [_ monad]) (#Cons [(#Meta [_ (#Tuple bindings)]) (#Cons [body #Nil])])]) +## (let [output (fold (lambda [body binding] +## (case' binding +## [lhs rhs] +## (` (lux;bind (lambda [(~ lhs)] (~ body)) +## (~ rhs))))) +## body +## (reverse (as-pairs bindings)))] +## (return (list (` (using (~ monad) (~ output)))))))) + +## (def (map% f xs) +## (All [m a b] +## (-> (-> a (m b)) (List a) (m (List b)))) +## (case' xs +## #Nil +## (return xs) + +## (#Cons [x xs']) +## (do [y (f x) +## ys (map% f xs')] +## (return (#Cons [y ys]))))) + +## ## (defmacro ($keys tokens) +## ## (case' tokens +## ## (#Cons [(#Meta [_ (#Tuple fields)]) #Nil]) +## ## (return (list (_meta (#Record (map (lambda [slot] +## ## (case' slot +## ## (#Meta [_ (#Tag [module name])]) +## ## [($ text-++ module ";" name) (_meta (#Symbol [module name]))])) +## ## fields))))))) + +## ## (defmacro ($or tokens) +## ## (case' tokens +## ## (#Cons [(#Meta [_ (#Tuple patterns)]) (#Cons [body #Nil])]) +## ## (return (flat-map (lambda [pattern] (list pattern body)) +## ## patterns)))) + +## ## (def null jvm-null) + +## (defmacro (^ tokens) +## (case' tokens +## (#Cons [(#Meta [_ (#Symbol [_ class-name])]) #Nil]) +## (return (list (` (#DataT (~ (_meta (#Text class-name))))))) +## )) + +## (defmacro (, members) +## (return (list (_meta (#Form (list+ (_meta (#Tag ["lux" "TupleT"])) (untemplate-list members))))))) + +## (defmacro (| members) +## (let [members' (map (lambda [m] +## (case' m +## (#Meta [_ (#Tag [module name])]) +## [($ text-++ module ";" name) (` (#Tuple (list)))] + +## (#Meta [_ (#Form (#Cons [(#Meta [_ (#Tag [module name])]) (#Cons [value #Nil])]))]) +## [($ text-++ module ";" name) (` (#Tuple (~ value)))])) +## members)] +## (return (list (_meta (#Form (list+ (_meta (#Tag ["lux" "VariantT"])) (untemplate-list members)))))))) + +## (defmacro (& members) +## (let [members' (map (lambda [m] +## (case' m +## (#Meta [_ (#Form (#Cons [(#Meta [_ (#Tag [module name])]) (#Cons [value #Nil])]))]) +## [($ text-++ module ";" name) (` (#Tuple (~ value)))])) +## members)] +## (return (list (_meta (#Form (list+ (_meta (#Tag ["lux" "RecordT"])) (untemplate-list members)))))))) + +## (defmacro (-> tokens) +## (case' (reverse tokens) +## (#Cons [f-return f-args]) +## (fold (lambda [f-return f-arg] +## (` (#LambdaT [(~ f-arg) (~ f-return)]))) +## f-return +## f-args))) + +## (def (text= x y) +## (-> Text Text Bool) +## (jvm-invokevirtual java.lang.Object "equals" [java.lang.Object] +## x [y])) + +## (def (replace-ident ident value syntax) +## (-> (, Text Text) Syntax Syntax Syntax) +## (let [[module name] ident] +## (case' syntax +## (#Meta [_ (#Symbol [?module ?name])]) +## (if (and (text= module ?module) +## (text= name ?name)) +## value +## syntax) + +## (#Meta [_ (#Form members)]) +## (_meta (#Form (map (replace-ident ident value) members))) + +## (#Meta [_ (#Tuple members)]) +## (_meta (#Tuple (map (replace-ident ident value) members))) + +## (#Meta [_ (#Record members)]) +## (_meta (#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 [(#Meta [_ (#Symbol [_ name])]) (#Cons [(#Meta [_ (#Tuple args)]) (#Cons [body #Nil])])]) +## [name args body] + +## (#Cons [(#Meta [_ (#Tuple args)]) (#Cons [body #Nil])]) +## ["" args body]) +## rolled (fold (lambda [body arg] +## (case' arg +## (#Meta [_ (#Symbol [arg-module arg-name])]) +## (` (#AllT (list) "" (~ (_meta (#Text arg-name))) (~ (replace-ident [arg-module arg-name] +## (` (#BoundT (~ (#Text arg-name)))) +## body)))))) +## body +## args)] +## (case' rolled +## (#Meta [_ (#Form (#Cons [(#Meta [_ (#Tag ["lux" "AllT"])]) (#Cons [env (#Cons [(#Meta [_ (#Text "")]) (#Cons [(#Meta [_ (#Text arg-name)]) (#Cons [body #Nil])])])])]))]) +## (return (list (` (#AllT (~ env) (~ (#Text name)) (~ (#Text arg-name)) +## (~ (replace-ident arg-name (` (#BoundT (~ (#Text name)))) +## body))))))))) + +## (defmacro (Exists tokens) +## (case' tokens +## (#Cons [args (#Cons [body #Nil])]) +## (return (list (` (All (~ args) (~ body))))))) + +## (def Any #AnyT) +## (def Nothing #NothingT) +## (def Bool (^ java.lang.Boolean)) +## (def Int (^ java.lang.Long)) +## (def Real (^ java.lang.Double)) +## (def Char (^ java.lang.Character)) +## (def Text (^ java.lang.String)) -## (def' let' -## (lambda' _ tokens -## (lambda' _ state -## (case' tokens -## (#Cons [lhs (#Cons [rhs (#Cons [body #Nil])])]) -## (#Right [state -## (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "case'"])) -## (#Cons [rhs (#Cons [lhs (#Cons [body #Nil])])])]))) -## #Nil])]) - -## _ -## (#Left "Wrong syntax for let'")) -## ))) -## (declare-macro' let') - -## ## ## (def' lambda -## ## ## (check' Macro -## ## ## (lambda' _ tokens -## ## ## (lambda' _ state -## ## ## (let' output (case' tokens -## ## ## (#Cons [(#Meta [_ (#Tuple (#Cons [arg args']))]) (#Cons [body #Nil])]) -## ## ## (_meta (#Form (#Cons [(_meta (#Symbol ["" "lambda'"])) -## ## ## (#Cons [(_meta (#Symbol ["" ""])) -## ## ## (#Cons [arg -## ## ## (#Cons [(case' args' -## ## ## #Nil -## ## ## body - -## ## ## _ -## ## ## (_meta (#Form (#Cons [(_meta (#Symbol ["lux" "lambda"])) -## ## ## (#Cons [(_meta (#Tuple args')) -## ## ## (#Cons [body #Nil])])])))) -## ## ## #Nil])])])]))) - -## ## ## (#Cons [(#Meta [_ (#Symbol self)]) (#Cons [(#Meta [_ (#Tuple (#Cons [arg args']))]) (#Cons [body #Nil])])]) -## ## ## (_meta (#Form (#Cons [(_meta (#Symbol ["" "lambda'"])) -## ## ## (#Cons [(_meta (#Symbol self)) -## ## ## (#Cons [arg -## ## ## (#Cons [(case' args' -## ## ## #Nil -## ## ## body - -## ## ## _ -## ## ## (_meta (#Form (#Cons [(_meta (#Symbol ["lux" "lambda"])) -## ## ## (#Cons [(_meta (#Tuple args')) -## ## ## (#Cons [body #Nil])])])))) -## ## ## #Nil])])])])))) -## ## ## (#Right [state (#Cons [output #Nil])])) -## ## ## )))) -## ## ## (declare-macro lambda) - -## ## ## (def' def -## ## ## (check' Macro -## ## ## (lambda [tokens state] -## ## ## (let' output (case' tokens -## ## ## (#Cons [(#Meta [_ (#Symbol name)]) (#Cons [body #Nil])]) -## ## ## (_meta (#Form (#Cons [(_meta (#Symbol ["" "def'"])) tokens]))) - -## ## ## (#Cons [(#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol name)]) args]))]) -## ## ## (#Cons [body #Nil])]) -## ## ## (_meta (#Form (#Cons [(_meta (#Symbol ["" "def'"])) -## ## ## (#Cons [(_meta (#Symbol name)) -## ## ## (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "lambda"])) -## ## ## (#Cons [(_meta (#Symbol name)) -## ## ## (#Cons [(_meta (#Tuple args)) -## ## ## (#Cons [body #Nil])])])]))) -## ## ## #Nil])])]))) - -## ## ## (#Cons [(#Meta [_ (#Symbol name)]) (#Cons [type (#Cons [body #Nil])])]) -## ## ## (_meta (#Form (#Cons [(_meta (#Symbol ["" "def'"])) -## ## ## (#Cons [(_meta (#Symbol name)) -## ## ## (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "check'"])) -## ## ## (#Cons [type -## ## ## (#Cons [body -## ## ## #Nil])])]))) -## ## ## #Nil])])]))) - -## ## ## (#Cons [(#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol name)]) args]))]) -## ## ## (#Cons [type (#Cons [body #Nil])])]) -## ## ## (_meta (#Form (#Cons [(_meta (#Symbol ["" "def'"])) -## ## ## (#Cons [(_meta (#Symbol name)) -## ## ## (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "check'"])) -## ## ## (#Cons [type -## ## ## (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "lambda"])) -## ## ## (#Cons [(_meta (#Symbol name)) -## ## ## (#Cons [(_meta (#Tuple args)) -## ## ## (#Cons [body #Nil])])])]))) -## ## ## #Nil])])]))) -## ## ## #Nil])])])))) -## ## ## (#Right [state (#Cons [output #Nil])]))))) -## ## ## (declare-macro def) - -## ## ## (def (defmacro tokens state) -## ## ## (let' [fn-name fn-def] (case' tokens -## ## ## (#Cons [(#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol fn-name)]) args]))]) -## ## ## (#Cons [body #Nil])]) -## ## ## [fn-name -## ## ## (_meta (#Form (#Cons [(_meta (#Symbol ["lux" "def"])) -## ## ## (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol fn-name)) args]))) -## ## ## (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "check'"])) -## ## ## (#Cons [(_meta (#Symbol ["lux;" "Macro"])) -## ## ## (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "lambda"])) -## ## ## (#Cons [(_meta (#Symbol name)) -## ## ## (#Cons [(_meta (#Tuple args)) -## ## ## (#Cons [body #Nil])])])]))) -## ## ## #Nil])])]))) -## ## ## #Nil])])])))]) -## ## ## (let' declaration (_meta (#Form (#Cons [(_meta (#Symbol ["" "declare-macro"])) (#Cons [(_meta (#Symbol fn-name)) #Nil])]))) -## ## ## (#Right [state (#Cons [fn-def (#Cons [declaration #Nil])])])))) -## ## ## (declare-macro defmacro) - -## ## ## (defmacro (comment tokens state) -## ## ## (#Right [state #Nil])) - -## ## ## (def (int+ x y) -## ## ## (-> Int Int Int) -## ## ## (jvm-ladd x y)) - -## ## ## (def (id x) -## ## ## (All [a] (-> a a)) -## ## ## x) - -## ## ## (def (print x) -## ## ## (-> (^ java.lang.Object) []) -## ## ## (jvm-invokevirtual java.io.PrintStream "print" [java.lang.Object] -## ## ## (jvm-getstatic java.lang.System "out") [x])) - -## ## ## (def (println x) -## ## ## (-> (^ java.lang.Object) []) -## ## ## (jvm-invokevirtual java.io.PrintStream "println" [java.lang.Object] -## ## ## (jvm-getstatic java.lang.System "out") [x])) - -## ## ## (deftype (IO a) -## ## ## (-> (,) a)) - -## ## ## (defmacro (io tokens) -## ## ## (case' tokens -## ## ## (#Cons [value #Nil]) -## ## ## (return (list (` (lambda [_] (~ value))))))) - -## ## ## (def (fold f init xs) -## ## ## (All [a b] -## ## ## (-> (-> a b a) a (List b) a)) -## ## ## (case' xs -## ## ## #Nil -## ## ## init - -## ## ## (#Cons [x xs']) -## ## ## (fold f (f init x) xs'))) - -## ## ## (def (reverse list) -## ## ## (All [a] -## ## ## (-> (List a) (List a))) -## ## ## (fold (lambda [tail head] -## ## ## (#Cons [head tail])) -## ## ## #Nil -## ## ## list)) - -## ## ## (defmacro (list xs state) -## ## ## (let' xs' (reverse xs) -## ## ## (let' output (fold (lambda [tail head] -## ## ## (_meta (#Form (#Cons [(_meta (#Tag ["lux" "Cons"])) -## ## ## (#Cons [(_meta (#Tuple (#Cons [head (#Cons [tail #Nil])]))) -## ## ## #Nil])])))) -## ## ## (_meta (#Tag ["lux" "Nil"])) -## ## ## xs') -## ## ## (#Right [state (#Cons [output #Nil])])))) - -## ## ## (defmacro (list+ xs state) -## ## ## (case' (reverse xs) -## ## ## #Nil -## ## ## [#Nil state] - -## ## ## (#Cons [last init']) -## ## ## (let' output (fold (lambda [tail head] -## ## ## (_meta (#Form (list (_meta (#Tag ["lux" "Cons"])) (_meta (#Tuple (list head tail))))))) -## ## ## last -## ## ## init') -## ## ## (#Right [state (#Cons [output #Nil])])))) - -## ## ## (def (as-pairs xs) -## ## ## (All [a] -## ## ## (-> (List a) (List [a a]))) -## ## ## (case' xs -## ## ## (#Cons [x (#Cons [y xs'])]) -## ## ## (#Cons [[x y] (as-pairs xs')]) - -## ## ## _ -## ## ## #Nil)) - -## ## ## (defmacro (let tokens state) -## ## ## (case' tokens -## ## ## (#Cons [(#Meta [_ (#Tuple bindings)]) (#Cons [body #Nil])]) -## ## ## (let' output (fold (lambda [body binding] -## ## ## (case' binding -## ## ## [label value] -## ## ## (_meta (#Form (list (_meta (#Symbol ["lux" "let'"])) label value body))))) -## ## ## body -## ## ## (reverse (as-pairs bindings))) -## ## ## (#Right [state (list output)])))) - -## ## ## (def (. f g) -## ## ## (All [a b c] -## ## ## (-> (-> b c) (-> a b) (-> a c))) -## ## ## (lambda [x] (f (g x)))) - -## ## ## (def (++ xs ys) -## ## ## (All [a] -## ## ## (-> (List a) (List a) (List a))) -## ## ## (case' xs -## ## ## #Nil -## ## ## ys - -## ## ## (#Cons [x xs']) -## ## ## (#Cons [x (++ xs' ys)]))) - -## ## ## (def concat -## ## ## (All [a] -## ## ## (-> (List (List a)) (List a))) -## ## ## (fold ++ #Nil)) - -## ## ## (def (map f xs) -## ## ## (All [a b] -## ## ## (-> (-> a b) (List a) (List b))) -## ## ## (case' xs -## ## ## #Nil -## ## ## #Nil - -## ## ## (#Cons [x xs']) -## ## ## (#Cons [(f x) (map f xs')]))) - -## ## ## (def flat-map -## ## ## (All [a b] -## ## ## (-> (-> a (List b)) (List a) (List b))) -## ## ## (. concat map)) - -## ## ## (def (wrap-meta content) -## ## ## ... -## ## ## (_meta (#Form (list (_meta (#Tag ["lux" "Meta"])) -## ## ## (_meta (#Tuple (list (_meta (#Tuple (list (_meta (#Form (list (_meta (#Tag ["lux" "Text"])) (_meta (#Text ""))))) -## ## ## (_meta (#Form (list (_meta (#Tag ["lux" "Int"])) (_meta (#Int -1))))) -## ## ## (_meta (#Form (list (_meta (#Tag ["lux" "Int"])) (_meta (#Int -1)))))))) -## ## ## (_meta content)))))))) - -## ## ## (def (untemplate-list tokens) -## ## ## (-> (List Syntax) Syntax) -## ## ## (case' tokens -## ## ## #Nil -## ## ## (_meta (#Tag ["lux" "Nil"])) - -## ## ## (#Cons [token tokens']) -## ## ## (_meta (#Form (list (_meta (#Tag ["lux" "Cons"])) -## ## ## (_meta (#Tuple (list token (untemplate-list tokens'))))))))) - -## ## ## (def (untemplate token) -## ## ## ... -## ## ## (case' token -## ## ## (#Meta [_ (#Bool value)]) -## ## ## (wrap-meta (#Form (list (_meta (#Tag ["lux" "Bool"])) (_meta (#Bool value))))) - -## ## ## (#Meta [_ (#Int value)]) -## ## ## (wrap-meta (#Form (list (_meta (#Tag ["lux" "Int"])) (_meta (#Int value))))) - -## ## ## (#Meta [_ (#Real value)]) -## ## ## (wrap-meta (#Form (list (_meta (#Tag ["lux" "Real"])) (_meta (#Real value))))) - -## ## ## (#Meta [_ (#Char value)]) -## ## ## (wrap-meta (#Form (list (_meta (#Tag ["lux" "Char"])) (_meta (#Char value))))) - -## ## ## (#Meta [_ (#Text value)]) -## ## ## (wrap-meta (#Form (list (_meta (#Tag ["lux" "Text"])) (_meta (#Text value))))) - -## ## ## (#Meta [_ (#Tag [module name])]) -## ## ## (wrap-meta (#Form (list (_meta (#Tag ["lux" "Tag"])) (_meta (#Tuple (list (_meta (#Text module)) (_meta (#Text name)))))))) - -## ## ## (#Meta [_ (#Symbol [module name])]) -## ## ## (wrap-meta (#Form (list (_meta (#Tag ["lux" "Symbol"])) (_meta (#Tuple (list (_meta (#Text module)) (_meta (#Text name)))))))) - -## ## ## (#Meta [_ (#Tuple elems)]) -## ## ## (wrap-meta (#Form (list (_meta (#Tag ["lux" "Tuple"])) (untemplate-list (map untemplate elems))))) - -## ## ## (#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol [_ "~"])]) (#Cons [(#Meta [_ unquoted]) #Nil])]))]) -## ## ## (_meta unquoted) - -## ## ## (#Meta [_ (#Form elems)]) -## ## ## (wrap-meta (#Form (list (_meta (#Tag ["lux" "Form"])) (untemplate-list (map untemplate elems))))) -## ## ## )) - -## ## ## (defmacro (` tokens state) -## ## ## (case' tokens -## ## ## (#Cons [template #Nil]) -## ## ## (#Right [state (list (untemplate template))]))) - -## ## ## (defmacro (if tokens state) -## ## ## (case' tokens -## ## ## (#Cons [test (#Cons [then (#Cons [else #Nil])])]) -## ## ## (#Right [state -## ## ## (list (` (case' (~ test) -## ## ## true (~ then) -## ## ## false (~ else))))]))) - -## ## ## (def (filter p xs) -## ## ## (All [a] -## ## ## (-> (-> a Bool) (List a) (List a))) -## ## ## (case' xs -## ## ## #Nil -## ## ## #Nil - -## ## ## (#Cons [x xs']) -## ## ## (if (p x) -## ## ## (#Cons [x (filter p xs')]) -## ## ## (filter p xs')))) - -## ## ## (deftype (LuxStateM a) -## ## ## (-> CompilerState (Either Text [CompilerState a]))) - -## ## ## (def (return val) -## ## ## (All [a] -## ## ## (-> a (LuxStateM a))) -## ## ## (lambda [state] -## ## ## (#Right [state val]))) - -## ## ## (def (fail msg) -## ## ## (-> Text (LuxStateM Nothing)) -## ## ## (lambda [_] -## ## ## (#Left msg))) - -## ## ## (def (bind f v) -## ## ## (All [m a b] (-> (-> a (m b)) (m a) (m b))) -## ## ## (lambda [state] -## ## ## (case' (v state) -## ## ## (#Right [state' x]) -## ## ## (f x state') - -## ## ## (#Left msg) -## ## ## (#Left msg)))) - -## ## ## (def (first pair) -## ## ## (All [a b] (-> (, a b) a)) -## ## ## (case' pair -## ## ## [f s] -## ## ## f)) - -## ## ## (def (second pair) -## ## ## (All [a b] (-> (, a b) b)) -## ## ## (case' pair -## ## ## [f s] -## ## ## s)) - -## ## ## (defmacro (loop tokens) -## ## ## (case' tokens -## ## ## (#Cons [bindings (#Cons [body #Nil])]) -## ## ## (let [pairs (as-pairs bindings)] -## ## ## (return (list (#Form (#Cons [(` (lambda (~ (#Symbol ["lux" "recur"])) (~ (#Tuple (map first pairs))) -## ## ## (~ body))) -## ## ## (map second pairs)]))))))) - -## ## ## (defmacro (export tokens) -## ## ## (return (map (lambda [t] (` (export' (~ t)))) -## ## ## tokens))) - -## ## ## (defmacro (and tokens) -## ## ## (let [as-if (case' tokens -## ## ## #Nil -## ## ## (` true) - -## ## ## (#Cons [init tests]) -## ## ## (fold (lambda [prev next] -## ## ## (` (if (~ prev) (~ next) false))) -## ## ## init -## ## ## tokens) -## ## ## )] -## ## ## (return (list as-if)))) - -## ## ## (defmacro (or tokens) -## ## ## (let [as-if (case' tokens -## ## ## #Nil -## ## ## (` false) - -## ## ## (#Cons [init tests]) -## ## ## (fold (lambda [prev next] -## ## ## (` (if (~ prev) true (~ next)))) -## ## ## init -## ## ## tokens) -## ## ## )] -## ## ## (return (list as-if)))) - -## ## ## (def (not x) -## ## ## (-> Bool Bool) -## ## ## (case' x -## ## ## true false -## ## ## false true)) - -## ## ## (defmacro (|> tokens) -## ## ## (case' tokens -## ## ## (#Cons [init apps]) -## ## ## (return (list (fold (lambda [acc app] -## ## ## (case' app -## ## ## (#Form parts) -## ## ## (#Form (++ parts (list acc))) - -## ## ## _ -## ## ## (` ((~ app) (~ acc))))) -## ## ## init -## ## ## apps))))) - -## ## ## (defmacro ($ tokens) -## ## ## (case' tokens -## ## ## (#Cons [op (#Cons [init args])]) -## ## ## (return (list (fold (lambda [acc elem] -## ## ## (` ((~ op) (~ acc) (~ elem)))) -## ## ## init -## ## ## args))))) - -## ## ## (def (const x) -## ## ## (All [a] -## ## ## (-> a (-> Any a))) -## ## ## (lambda [_] -## ## ## x)) - -## ## ## (def (int> x y) -## ## ## (-> Int Int Bool) -## ## ## (jvm-lgt x y)) - -## ## ## (def (int< x y) -## ## ## (-> Int Int Bool) -## ## ## (jvm-llt x y)) - -## ## ## (def inc -## ## ## (-> Int Int) -## ## ## (int+ 1)) - -## ## ## (def dec -## ## ## (-> Int Int) -## ## ## (int+ -1)) - -## ## ## (def (repeat n x) -## ## ## (All [a] (-> Int a (List a))) -## ## ## (if (int> n 0) -## ## ## (#Cons [x (repeat (dec n) x)]) -## ## ## #Nil)) - -## ## ## (def size -## ## ## (All [a] -## ## ## (-> (List a) Int)) -## ## ## (fold (lambda [acc _] (inc acc)) 0)) - -## ## ## (def (last xs) -## ## ## (All [a] -## ## ## (-> (List a) (Maybe a))) -## ## ## (case' xs -## ## ## #Nil #None -## ## ## (#Cons [x #Nil]) (#Some x) -## ## ## (#Cons [_ xs']) (last xs'))) - -## ## ## (def (init xs) -## ## ## (All [a] -## ## ## (-> (List a) (Maybe (List a)))) -## ## ## (case' xs -## ## ## #Nil #None -## ## ## (#Cons [_ #Nil]) (#Some #Nil) -## ## ## (#Cons [x xs']) (case' (init xs') -## ## ## (#Some xs'') -## ## ## (#Some (#Cons [x xs''])) - -## ## ## _ -## ## ## (#Some (#Cons [x #Nil]))))) - -## ## ## (defmacro (cond tokens) -## ## ## (case' (reverse tokens) -## ## ## (#Cons [else branches']) -## ## ## (return (list (fold (lambda [else branch] -## ## ## (case' branch -## ## ## [test then] -## ## ## (` (if (~ test) (~ then) (~ else))))) -## ## ## else -## ## ## (|> branches' reverse as-pairs)))))) - -## ## ## (def (interleave xs ys) -## ## ## (All [a] -## ## ## (-> (List a) (List a) (List a))) -## ## ## (case' [xs ys] -## ## ## [(#Cons [x xs']) (#Cons [y ys'])] -## ## ## (list+ x y (interleave xs' ys')) - -## ## ## _ -## ## ## #Nil)) - -## ## ## (def (interpose sep xs) -## ## ## (All [a] -## ## ## (-> a (List a) (List a))) -## ## ## (case' xs -## ## ## #Nil -## ## ## xs - -## ## ## (#Cons [x #Nil]) -## ## ## xs - -## ## ## (#Cons [x xs']) -## ## ## (list+ x sep (interpose sep xs')))) - -## ## ## (def (empty? xs) -## ## ## (All [a] -## ## ## (-> (List a) Bool)) -## ## ## (case' xs -## ## ## #Nil true -## ## ## _ false)) - -## ## ## ## ## ## (do-template [<name> <op>] -## ## ## ## ## ## (def (<name> p xs) -## ## ## ## ## ## (case xs -## ## ## ## ## ## #Nil true -## ## ## ## ## ## (#Cons [x xs']) (<op> (p x) (<name> p xs')))) - -## ## ## ## ## ## [every? and] -## ## ## ## ## ## [any? or]) - -## ## ## (def (range from to) -## ## ## (-> Int Int (List Int)) -## ## ## (if (int< from to) -## ## ## (#Cons [from (range (inc from) to)]) -## ## ## #Nil)) - -## ## ## (def (tuple->list tuple) -## ## ## (-> Syntax (List Syntax)) -## ## ## (case' tuple -## ## ## (#Meta [_ (#Tuple list)]) -## ## ## list)) - -## ## ## (def (zip2 xs ys) -## ## ## (All [a b] -## ## ## (-> (List a) (List b) (List (, a b)))) -## ## ## (case' [xs ys] -## ## ## [(#Cons [x xs']) (#Cons [y ys'])] -## ## ## (#Cons [[x y] (zip2 xs' ys')]) - -## ## ## _ -## ## ## #Nil)) - -## ## ## (def (get key map) -## ## ## (All [a b] -## ## ## (-> a (List (, a b)) (Maybe b))) -## ## ## (case' map -## ## ## #Nil -## ## ## #None - -## ## ## (#Cons [[k v] map']) -## ## ## (if (jvm-invokevirtual java.lang.Object "equals" [java.lang.Object] -## ## ## k [key]) -## ## ## (#Some v) -## ## ## (get key map')))) - -## ## ## (def (get-ident x) -## ## ## (-> Syntax Text) -## ## ## (case' x -## ## ## (#Meta [_ (#Symbol [_ ident])]) -## ## ## ident)) - -## ## ## (def (text-++ x y) -## ## ## (-> Text Text Text) -## ## ## (jvm-invokevirtual java.lang.String "concat" [java.lang.String] -## ## ## x [y])) - -## ## ## (def (show-env env) -## ## ## ... -## ## ## (|> env (map first) (interpose ", ") (fold text-++ ""))) - -## ## ## (def (apply-template env template) -## ## ## (case' template -## ## ## (#Meta [_ (#Symbol [_ ident])]) -## ## ## (case' (get ident env) -## ## ## (#Some subst) -## ## ## subst - -## ## ## _ -## ## ## template) - -## ## ## (#Meta [_ (#Tuple elems)]) -## ## ## (_meta (#Tuple (map (apply-template env) elems))) - -## ## ## (#Meta [_ (#Form elems)]) -## ## ## (_meta (#Form (map (apply-template env) elems))) - -## ## ## (#Meta [_ (#Record members)]) -## ## ## (_meta (#Record (map (lambda [kv] -## ## ## (case' kv -## ## ## [slot value] -## ## ## [(apply-template env slot) (apply-template env value)])) -## ## ## members))) - -## ## ## _ -## ## ## template)) - -## ## ## (defmacro (do-templates tokens) -## ## ## (case' tokens -## ## ## (#Cons [bindings (#Cons [(#Meta [_ (#Tuple templates)]) data])]) -## ## ## (let [bindings-list (map get-ident (tuple->list bindings)) -## ## ## data-lists (map tuple->list data) -## ## ## apply (lambda [env] (map (apply-template env) templates))] -## ## ## (|> data-lists -## ## ## (map (. apply (zip2 bindings-list))) -## ## ## return)))) - -## ## ## ## ## ## (do-template [<name> <offset>] -## ## ## ## ## ## (def <name> (int+ <offset>)) - -## ## ## ## ## ## [inc 1] -## ## ## ## ## ## [dec -1]) - -## ## ## (def (int= x y) -## ## ## (-> Int Int Bool) -## ## ## (jvm-leq x y)) - -## ## ## (def (int% x y) -## ## ## (-> Int Int Int) -## ## ## (jvm-lrem x y)) - -## ## ## (def (int>= x y) -## ## ## (-> Int Int Bool) -## ## ## (or (int= x y) -## ## ## (int> x y))) - -## ## ## (do-templates [<name> <cmp>] -## ## ## [(def (<name> x y) -## ## ## (-> Int Int Int) -## ## ## (if (<cmp> x y) -## ## ## x -## ## ## y))] - -## ## ## [max int>] -## ## ## [min int<]) - -## ## ## (do-templates [<name> <cmp>] -## ## ## [(def (<name> n) -## ## ## (-> Int Bool) -## ## ## (<cmp> n 0))] - -## ## ## [neg? int<] -## ## ## [pos? int>=]) - -## ## ## (def (even? n) -## ## ## (-> Int Bool) -## ## ## (int= 0 (int% n 0))) - -## ## ## (def (odd? n) -## ## ## (-> Int Bool) -## ## ## (not (even? n))) - -## ## ## (do-templates [<name> <done> <step>] -## ## ## [(def (<name> n xs) -## ## ## (All [a] -## ## ## (-> Int (List a) (List a))) -## ## ## (if (int> n 0) -## ## ## (case' xs -## ## ## #Nil #Nil -## ## ## (#Cons [x xs']) <step>) -## ## ## <done>))] - -## ## ## [take #Nil (list+ x (take (dec n) xs'))] -## ## ## [drop xs (drop (dec n) xs')]) - -## ## ## (do-templates [<name> <done> <step>] -## ## ## [(def (<name> f xs) -## ## ## (All [a] -## ## ## (-> (-> a Bool) (List a) (List a))) -## ## ## (case' xs -## ## ## #Nil #Nil -## ## ## (#Cons [x xs']) (if (f x) <step> #Nil)))] - -## ## ## [take-while #Nil (list+ x (take-while f xs'))] -## ## ## [drop-while xs (drop-while f xs')]) - -## ## ## ## (defmacro (get@ tokens) -## ## ## ## (let [output (case' tokens -## ## ## ## (#Cons [tag (#Cons [record #Nil])]) -## ## ## ## (` (get@' (~ tag) (~ record))) - -## ## ## ## (#Cons [tag #Nil]) -## ## ## ## (` (lambda [record] (get@' (~ tag) record))))] -## ## ## ## (return (list output)))) - -## ## ## ## (defmacro (set@ tokens) -## ## ## ## (let [output (case' tokens -## ## ## ## (#Cons [tag (#Cons [value (#Cons [record #Nil])])]) -## ## ## ## (` (set@' (~ tag) (~ value) (~ record))) - -## ## ## ## (#Cons [tag (#Cons [value #Nil])]) -## ## ## ## (` (lambda [record] (set@' (~ tag) (~ value) record))) - -## ## ## ## (#Cons [tag #Nil]) -## ## ## ## (` (lambda [value record] (set@' (~ tag) value record))))] -## ## ## ## (return (list output)))) - -## ## ## ## (defmacro (update@ tokens) -## ## ## ## (let [output (case' tokens -## ## ## ## (#Cons [tag (#Cons [func (#Cons [record #Nil])])]) -## ## ## ## (` (let [_record_ (~ record)] -## ## ## ## (set@' (~ tag) ((~ func) (get@' (~ tag) _record_)) _record_))) - -## ## ## ## (#Cons [tag (#Cons [func #Nil])]) -## ## ## ## (` (lambda [record] -## ## ## ## (` (set@' (~ tag) ((~ func) (get@' (~ tag) record)) record)))) - -## ## ## ## (#Cons [tag #Nil]) -## ## ## ## (` (lambda [func record] -## ## ## ## (set@' (~ tag) (func (get@' (~ tag) record)) record))))] -## ## ## ## (return (list output)))) - -## ## ## (def (show-int int) -## ## ## (-> Int Text) -## ## ## (jvm-invokevirtual java.lang.Object "toString" [] -## ## ## int [])) - -## ## ## (def gensym -## ## ## (LuxStateM Syntax) -## ## ## (lambda [state] -## ## ## [(update@ [#gen-seed] inc state) -## ## ## (_meta (#Symbol ($ text-++ "__" (show-int (get@ [#gen-seed] state)) "__")))])) - -## ## ## ## (do-template [<name> <member>] -## ## ## ## (def (<name> pair) -## ## ## ## (case' pair -## ## ## ## [f s] -## ## ## ## <member>)) - -## ## ## ## [first f] -## ## ## ## [second s]) - -## ## ## (def (show-syntax syntax) -## ## ## (-> Syntax Text) -## ## ## (case' syntax -## ## ## (#Meta [_ (#Bool value)]) -## ## ## (jvm-invokevirtual java.lang.Object "toString" [] -## ## ## value []) - -## ## ## (#Meta [_ (#Int value)]) -## ## ## (jvm-invokevirtual java.lang.Object "toString" [] -## ## ## value []) - -## ## ## (#Meta [_ (#Real value)]) -## ## ## (jvm-invokevirtual java.lang.Object "toString" [] -## ## ## value []) - -## ## ## (#Meta [_ (#Char value)]) -## ## ## (jvm-invokevirtual java.lang.Object "toString" [] -## ## ## value []) - -## ## ## (#Meta [_ (#Text value)]) -## ## ## (jvm-invokevirtual java.lang.Object "toString" [] -## ## ## value []) - -## ## ## (#Meta [_ (#Symbol [module name])]) -## ## ## ($ text-++ module ";" name) - -## ## ## (#Meta [_ (#Tag [module name])]) -## ## ## ($ text-++ "#" module ";" name) - -## ## ## (#Meta [_ (#Tuple members)]) -## ## ## ($ text-++ "[" (fold text-++ "" (interpose " " (map show-syntax members))) "]") - -## ## ## (#Meta [_ (#Form members)]) -## ## ## ($ text-++ "(" (fold text-++ "" (interpose " " (map show-syntax members))) ")") -## ## ## )) - -## ## ## (defmacro (do tokens) -## ## ## (case' tokens -## ## ## (#Cons [(#Meta [_ monad]) (#Cons [(#Meta [_ (#Tuple bindings)]) (#Cons [body #Nil])])]) -## ## ## (let [output (fold (lambda [body binding] -## ## ## (case' binding -## ## ## [lhs rhs] -## ## ## (` (lux;bind (lambda [(~ lhs)] (~ body)) -## ## ## (~ rhs))))) -## ## ## body -## ## ## (reverse (as-pairs bindings)))] -## ## ## (return (list (` (using (~ monad) (~ output)))))))) - -## ## ## (def (map% f xs) -## ## ## (All [m a b] -## ## ## (-> (-> a (m b)) (List a) (m (List b)))) -## ## ## (case' xs -## ## ## #Nil -## ## ## (return xs) - -## ## ## (#Cons [x xs']) -## ## ## (do [y (f x) -## ## ## ys (map% f xs')] -## ## ## (return (#Cons [y ys]))))) - -## ## ## ## (defmacro ($keys tokens) -## ## ## ## (case' tokens -## ## ## ## (#Cons [(#Meta [_ (#Tuple fields)]) #Nil]) -## ## ## ## (return (list (_meta (#Record (map (lambda [slot] -## ## ## ## (case' slot -## ## ## ## (#Meta [_ (#Tag [module name])]) -## ## ## ## [($ text-++ module ";" name) (_meta (#Symbol [module name]))])) -## ## ## ## fields))))))) - -## ## ## ## (defmacro ($or tokens) -## ## ## ## (case' tokens -## ## ## ## (#Cons [(#Meta [_ (#Tuple patterns)]) (#Cons [body #Nil])]) -## ## ## ## (return (flat-map (lambda [pattern] (list pattern body)) -## ## ## ## patterns)))) - -## ## ## ## (def null jvm-null) - -## ## ## (defmacro (^ tokens) -## ## ## (case' tokens -## ## ## (#Cons [(#Meta [_ (#Symbol [_ class-name])]) #Nil]) -## ## ## (return (list (` (#DataT (~ (_meta (#Text class-name))))))) -## ## ## )) - -## ## ## (defmacro (, members) -## ## ## (return (list (_meta (#Form (list+ (_meta (#Tag ["lux" "TupleT"])) (untemplate-list members))))))) - -## ## ## (defmacro (| members) -## ## ## (let [members' (map (lambda [m] -## ## ## (case' m -## ## ## (#Meta [_ (#Tag [module name])]) -## ## ## [($ text-++ module ";" name) (` (#Tuple (list)))] - -## ## ## (#Meta [_ (#Form (#Cons [(#Meta [_ (#Tag [module name])]) (#Cons [value #Nil])]))]) -## ## ## [($ text-++ module ";" name) (` (#Tuple (~ value)))])) -## ## ## members)] -## ## ## (return (list (_meta (#Form (list+ (_meta (#Tag ["lux" "VariantT"])) (untemplate-list members)))))))) - -## ## ## (defmacro (& members) -## ## ## (let [members' (map (lambda [m] -## ## ## (case' m -## ## ## (#Meta [_ (#Form (#Cons [(#Meta [_ (#Tag [module name])]) (#Cons [value #Nil])]))]) -## ## ## [($ text-++ module ";" name) (` (#Tuple (~ value)))])) -## ## ## members)] -## ## ## (return (list (_meta (#Form (list+ (_meta (#Tag ["lux" "RecordT"])) (untemplate-list members)))))))) - -## ## ## (defmacro (-> tokens) -## ## ## (case' (reverse tokens) -## ## ## (#Cons [f-return f-args]) -## ## ## (fold (lambda [f-return f-arg] -## ## ## (` (#LambdaT [(~ f-arg) (~ f-return)]))) -## ## ## f-return -## ## ## f-args))) - -## ## ## (def (text= x y) -## ## ## (-> Text Text Bool) -## ## ## (jvm-invokevirtual java.lang.Object "equals" [java.lang.Object] -## ## ## x [y])) - -## ## ## (def (replace-ident ident value syntax) -## ## ## (-> (, Text Text) Syntax Syntax Syntax) -## ## ## (let [[module name] ident] -## ## ## (case' syntax -## ## ## (#Meta [_ (#Symbol [?module ?name])]) -## ## ## (if (and (text= module ?module) -## ## ## (text= name ?name)) -## ## ## value -## ## ## syntax) - -## ## ## (#Meta [_ (#Form members)]) -## ## ## (_meta (#Form (map (replace-ident ident value) members))) - -## ## ## (#Meta [_ (#Tuple members)]) -## ## ## (_meta (#Tuple (map (replace-ident ident value) members))) - -## ## ## (#Meta [_ (#Record members)]) -## ## ## (_meta (#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 [(#Meta [_ (#Symbol [_ name])]) (#Cons [(#Meta [_ (#Tuple args)]) (#Cons [body #Nil])])]) -## ## ## [name args body] - -## ## ## (#Cons [(#Meta [_ (#Tuple args)]) (#Cons [body #Nil])]) -## ## ## ["" args body]) -## ## ## rolled (fold (lambda [body arg] -## ## ## (case' arg -## ## ## (#Meta [_ (#Symbol [arg-module arg-name])]) -## ## ## (` (#AllT (list) "" (~ (_meta (#Text arg-name))) (~ (replace-ident [arg-module arg-name] -## ## ## (` (#BoundT (~ (#Text arg-name)))) -## ## ## body)))))) -## ## ## body -## ## ## args)] -## ## ## (case' rolled -## ## ## (#Meta [_ (#Form (#Cons [(#Meta [_ (#Tag ["lux" "AllT"])]) (#Cons [env (#Cons [(#Meta [_ (#Text "")]) (#Cons [(#Meta [_ (#Text arg-name)]) (#Cons [body #Nil])])])])]))]) -## ## ## (return (list (` (#AllT (~ env) (~ (#Text name)) (~ (#Text arg-name)) -## ## ## (~ (replace-ident arg-name (` (#BoundT (~ (#Text name)))) -## ## ## body))))))))) - -## ## ## (defmacro (Exists tokens) -## ## ## (case' tokens -## ## ## (#Cons [args (#Cons [body #Nil])]) -## ## ## (return (list (` (All (~ args) (~ body))))))) - -## ## ## (def Any #AnyT) -## ## ## (def Nothing #NothingT) -## ## ## (def Bool (^ java.lang.Boolean)) -## ## ## (def Int (^ java.lang.Long)) -## ## ## (def Real (^ java.lang.Double)) -## ## ## (def Char (^ java.lang.Character)) -## ## ## (def Text (^ java.lang.String)) - -## ## ## (deftype (List a) -## ## ## (| #Nil -## ## ## (#Cons (, a (List a))))) - -## ## ## (deftype #rec Type -## ## ## (| #AnyT -## ## ## #NothingT -## ## ## (#DataT Text) -## ## ## (#TupleT (List Type)) -## ## ## (#VariantT (List (, Text Type))) -## ## ## (#RecordT (List (, Text Type))) -## ## ## (#LambdaT (, Type Type)) -## ## ## (#BoundT Text) -## ## ## (#VarT Int) -## ## ## (#AllT (, (List (, Text Type)) Text Text Type)) -## ## ## (#AppT (, Type Type)))) - -## ## ## (deftype (Either l r) -## ## ## (| (#Left l) -## ## ## (#Right r))) - -## ## ## (deftype #rec Syntax -## ## ## (| (#Bool Bool) -## ## ## (#Int Int) -## ## ## (#Real Real) -## ## ## (#Char Char) -## ## ## (#Text Text) -## ## ## (#Form (List Syntax)) -## ## ## (#Tuple (List Syntax)) -## ## ## (#Record (List (, Text Syntax))))) - -## ## ## (deftype Macro -## ## ## (-> (List Syntax) CompilerState -## ## ## (Either Text (, CompilerState (List Syntax))))) - -## ## ## (def (macro-expand syntax) -## ## ## (-> Syntax (LuxStateM (List Syntax))) -## ## ## (case' syntax -## ## ## (#Form (#Cons [(#Symbol macro-name) args])) -## ## ## (do [macro (get-macro macro-name)] -## ## ## ((coerce macro Macro) args)))) - -## ## ## (defmacro (case tokens) -## ## ## (case' tokens -## ## ## (#Cons value branches) -## ## ## (loop [kind #Pattern -## ## ## pieces branches -## ## ## new-pieces (list)] -## ## ## (case' pieces -## ## ## #Nil -## ## ## (return (list (' (case' (~ value) (~@ new-pieces))))) - -## ## ## (#Cons piece pieces') -## ## ## (let [[kind' expanded more-pieces] (case' kind -## ## ## #Body -## ## ## [#Pattern (list piece) #Nil] - -## ## ## #Pattern -## ## ## (do [expansion (macro-expand piece)] -## ## ## (case' expansion -## ## ## #Nil -## ## ## [#Pattern #Nil #Nil] - -## ## ## (#Cons exp #Nil) -## ## ## [#Body (list exp) #Nil] - -## ## ## (#Cons exp exps) -## ## ## [#Body (list exp) exps])) -## ## ## )] -## ## ## (recur kind' (++ expanded new-pieces) (++ more-pieces pieces)))) -## ## ## ))) - -## ## ## (def (defsyntax tokens) +## (deftype (List a) +## (| #Nil +## (#Cons (, a (List a))))) + +## (deftype #rec Type +## (| #AnyT +## #NothingT +## (#DataT Text) +## (#TupleT (List Type)) +## (#VariantT (List (, Text Type))) +## (#RecordT (List (, Text Type))) +## (#LambdaT (, Type Type)) +## (#BoundT Text) +## (#VarT Int) +## (#AllT (, (List (, Text Type)) Text Text Type)) +## (#AppT (, Type Type)))) + +## (deftype (Either l r) +## (| (#Left l) +## (#Right r))) + +## (deftype #rec Syntax +## (| (#Bool Bool) +## (#Int Int) +## (#Real Real) +## (#Char Char) +## (#Text Text) +## (#Form (List Syntax)) +## (#Tuple (List Syntax)) +## (#Record (List (, Text Syntax))))) + +## (deftype Macro +## (-> (List Syntax) CompilerState +## (Either Text (, CompilerState (List Syntax))))) + +## (def (macro-expand syntax) +## (-> Syntax (LuxStateM (List Syntax))) +## (case' syntax +## (#Form (#Cons [(#Symbol macro-name) args])) +## (do [macro (get-macro macro-name)] +## ((coerce macro Macro) args)))) + +## (defmacro (case tokens) +## (case' tokens +## (#Cons value branches) +## (loop [kind #Pattern +## pieces branches +## new-pieces (list)] +## (case' pieces +## #Nil +## (return (list (' (case' (~ value) (~@ new-pieces))))) + +## (#Cons piece pieces') +## (let [[kind' expanded more-pieces] (case' kind +## #Body +## [#Pattern (list piece) #Nil] + +## #Pattern +## (do [expansion (macro-expand piece)] +## (case' expansion +## #Nil +## [#Pattern #Nil #Nil] + +## (#Cons exp #Nil) +## [#Body (list exp) #Nil] + +## (#Cons exp exps) +## [#Body (list exp) exps])) +## )] +## (recur kind' (++ expanded new-pieces) (++ more-pieces pieces)))) +## ))) + +## (def (defsyntax tokens) +## ...) + +## (deftype (State s a) +## (-> s (, s a))) + +## (deftype (Parser a) +## (State (List Syntax) a)) + +## (def (parse-ctor tokens) +## (Parser (, Syntax (List Syntax))) +## (case tokens +## (list+ (#Symbol name) tokens') +## [tokens' [(#Symbol name) (list)]] + +## (list+ (#Form (list+ (#Symbol name) args)) tokens') +## [tokens' [(#Symbol name) args]])) + +## (defsyntax (defsig +## [[name args] parse-ctor] +## [anns ($+ $1)]) +## (let [def-body (fold (lambda [body arg] (` (lambda [(~ arg)] (~ body)))) +## (` (#Record (~ (untemplate-list ...)))) +## args)] +## (return (list (` (def (~ name) (~ def-body))))))) + +## (defsyntax (defstruct +## [[name args] parse-ctor] +## signature +## [defs ($+ $1)]) +## (let [def-body (fold (lambda [body arg] (` (lambda [(~ arg)] (~ body)))) +## (` (#Record (~ (untemplate-list ...)))) +## args)] +## (return (list (` (def (~ name) +## (: (~ def-body) (~ signature)))))))) + +## (defsig (Monad m) +## (: return (All [a] (-> a (m a)))) +## (: bind (All [a b] (-> (-> a (m b)) (m a) (m b))))) + +## (defstruct ListMonad (Monad List) +## (def (return x) +## (list x)) + +## (def bind (. concat map))) + +## (defsig (Eq a) +## (: = (-> a a Bool))) + +## (defstruct (List_Eq A_Eq) +## (All [a] (-> (Eq a) (Eq (List a)))) + +## (def (= xs ys) +## (and (= (length xs) (length ys)) +## (map (lambda [[x y]] +## (with A_Eq +## (= x y))) +## (zip2 xs ys))))) + +## ## ## (def (with tokens) ## ## ## ...) -## ## ## (deftype (State s a) -## ## ## (-> s (, s a))) +## ## ## TODO: Full pattern-matching +## ## ## TODO: Type-related macros +## ## ## TODO: (Im|Ex)ports-related macros +## ## ## TODO: Macro-related macros -## ## ## (deftype (Parser a) -## ## ## (State (List Syntax) a)) +## ## ## (import "lux") +## ## ## (module-alias "lux" "l") +## ## ## (def-alias "lux;map" "map") -## ## ## (def (parse-ctor tokens) -## ## ## (Parser (, Syntax (List Syntax))) +## ## ## (def (require tokens) ## ## ## (case tokens -## ## ## (list+ (#Symbol name) tokens') -## ## ## [tokens' [(#Symbol name) (list)]] - -## ## ## (list+ (#Form (list+ (#Symbol name) args)) tokens') -## ## ## [tokens' [(#Symbol name) args]])) - -## ## ## (defsyntax (defsig -## ## ## [[name args] parse-ctor] -## ## ## [anns ($+ $1)]) -## ## ## (let [def-body (fold (lambda [body arg] (` (lambda [(~ arg)] (~ body)))) -## ## ## (` (#Record (~ (untemplate-list ...)))) -## ## ## args)] -## ## ## (return (list (` (def (~ name) (~ def-body))))))) - -## ## ## (defsyntax (defstruct -## ## ## [[name args] parse-ctor] -## ## ## signature -## ## ## [defs ($+ $1)]) -## ## ## (let [def-body (fold (lambda [body arg] (` (lambda [(~ arg)] (~ body)))) -## ## ## (` (#Record (~ (untemplate-list ...)))) -## ## ## args)] -## ## ## (return (list (` (def (~ name) -## ## ## (: (~ def-body) (~ signature)))))))) - -## ## ## (defsig (Monad m) -## ## ## (: return (All [a] (-> a (m a)))) -## ## ## (: bind (All [a b] (-> (-> a (m b)) (m a) (m b))))) - -## ## ## (defstruct ListMonad (Monad List) -## ## ## (def (return x) -## ## ## (list x)) - -## ## ## (def bind (. concat map))) - -## ## ## (defsig (Eq a) -## ## ## (: = (-> a a Bool))) - -## ## ## (defstruct (List_Eq A_Eq) -## ## ## (All [a] (-> (Eq a) (Eq (List a)))) - -## ## ## (def (= xs ys) -## ## ## (and (= (length xs) (length ys)) -## ## ## (map (lambda [[x y]] -## ## ## (with A_Eq -## ## ## (= x y))) -## ## ## (zip2 xs ys))))) - -## ## ## ## ## (def (with tokens) -## ## ## ## ## ...) - -## ## ## ## ## TODO: Full pattern-matching -## ## ## ## ## TODO: Type-related macros -## ## ## ## ## TODO: (Im|Ex)ports-related macros -## ## ## ## ## TODO: Macro-related macros - -## ## ## ## ## (import "lux") -## ## ## ## ## (module-alias "lux" "l") -## ## ## ## ## (def-alias "lux;map" "map") - -## ## ## ## ## (def (require tokens) -## ## ## ## ## (case tokens -## ## ## ## ## ...)) - -## ## ## ## ## (require lux #as l #refer [map]) +## ## ## ...)) + +## ## ## (require lux #as l #refer [map]) diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index 7f65c6476..181d76b5b 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -66,48 +66,48 @@ [["lux;Meta" [meta ["lux;Tag" ?ident]]]] (&&lux/analyse-variant analyse exo-type ?ident (_meta (&/V "lux;Tuple" (|list)))) - [["lux;Meta" [meta ["lux;Symbol" [_ "jvm-null"]]]]] + [["lux;Meta" [meta ["lux;Symbol" ["" "jvm-null"]]]]] (return (&/|list (&/V "Expression" (&/T (&/V "jvm-null" nil) (&/V "lux;DataT" "null"))))) [["lux;Meta" [meta ["lux;Symbol" ?ident]]]] (&&lux/analyse-symbol analyse exo-type ?ident) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "case'"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "case'"]]]] ["lux;Cons" [?value ?branches]]]]]]]] (&&lux/analyse-case analyse exo-type ?value ?branches) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "lambda'"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "lambda'"]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ?self]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ?arg]]] ["lux;Cons" [?body ["lux;Nil" _]]]]]]]]]]]]] (&&lux/analyse-lambda analyse exo-type ?self ?arg ?body) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "def'"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "def'"]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?name]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]]]] (do ;; (when (= "if" ?name) ;; (prn "if" (&/show-ast ?value))) - (&&lux/analyse-def analyse exo-type ?name ?value)) + (&&lux/analyse-def analyse ?name ?value)) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "declare-macro'"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "declare-macro'"]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ?ident]]] ["lux;Nil" _]]]]]]]]] (&&lux/analyse-declare-macro ?ident) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "import'"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "import'"]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Text" ?path]]] ["lux;Nil" _]]]]]]]]] (&&lux/analyse-import analyse ?path) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "check'"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "check'"]]]] ["lux;Cons" [?type ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]]]] (&&lux/analyse-check analyse eval! exo-type ?type ?value) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "coerce'"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "coerce'"]]]] ["lux;Cons" [?type ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]]]] @@ -115,139 +115,139 @@ ;; Host special forms ;; Integer arithmetic - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-iadd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-iadd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-iadd analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-isub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-isub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-isub analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-imul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-imul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-imul analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-idiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-idiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-idiv analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-irem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-irem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-irem analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-ieq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-ieq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-ieq analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-ilt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-ilt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-ilt analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-igt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-igt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-igt analyse ?x ?y) ;; Long arithmetic - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-ladd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-ladd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-ladd analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-lsub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-lsub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-lsub analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-lmul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-lmul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-lmul analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-ldiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-ldiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-ldiv analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-lrem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-lrem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-lrem analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-leq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-leq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-leq analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-llt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-llt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-llt analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-lgt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-lgt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-lgt analyse ?x ?y) ;; Float arithmetic - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-fadd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-fadd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-fadd analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-fsub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-fsub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-fsub analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-fmul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-fmul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-fmul analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-fdiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-fdiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-fdiv analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-frem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-frem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-frem analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-feq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-feq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-feq analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-flt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-flt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-flt analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-fgt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-fgt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-fgt analyse ?x ?y) ;; Double arithmetic - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-dadd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-dadd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-dadd analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-dsub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-dsub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-dsub analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-dmul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-dmul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-dmul analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-ddiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-ddiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-ddiv analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-drem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-drem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-drem analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-deq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-deq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-deq analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-dlt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-dlt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-dlt analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-dgt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-dgt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-dgt analyse ?x ?y) ;; Objects - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-null?"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-null?"]]]] ["lux;Cons" [?object ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-null? analyse ?object) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-new"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-new"]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?class]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Tuple" ?classes]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Tuple" ?args]]] ["lux;Nil" _]]]]]]]]]]]]] (&&host/analyse-jvm-new analyse ?class ?classes ?args) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-getstatic"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-getstatic"]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?class]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Text" ?field]]] ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-getstatic analyse ?class ?field) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-getfield"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-getfield"]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?class]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Text" ?field]]] ["lux;Cons" [?object ["lux;Nil" _]]]]]]]]]]]]] (&&host/analyse-jvm-getfield analyse ?class ?field ?object) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-putstatic"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-putstatic"]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?class]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Text" ?field]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]]]]]] (&&host/analyse-jvm-putstatic analyse ?class ?field ?value) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-putfield"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-putfield"]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?class]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Text" ?field]]] ["lux;Cons" [?object @@ -255,7 +255,7 @@ ["lux;Nil" _]]]]]]]]]]]]]]] (&&host/analyse-jvm-putfield analyse ?class ?field ?object ?value) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-invokestatic"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-invokestatic"]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?class]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Text" ?method]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Tuple" ?classes]]] @@ -263,7 +263,7 @@ ["lux;Nil" _]]]]]]]]]]]]]]] (&&host/analyse-jvm-invokestatic analyse ?class ?method ?classes ?args) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-invokevirtual"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-invokevirtual"]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?class]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Text" ?method]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Tuple" ?classes]]] @@ -272,7 +272,7 @@ ["lux;Nil" _]]]]]]]]]]]]]]]]] (&&host/analyse-jvm-invokevirtual analyse ?class ?method ?classes ?object ?args) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-invokeinterface"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-invokeinterface"]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?class]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Text" ?method]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Tuple" ?classes]]] @@ -281,7 +281,7 @@ ["lux;Nil" _]]]]]]]]]]]]]]]]] (&&host/analyse-jvm-invokeinterface analyse ?class ?method ?classes ?object ?args) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-invokespecial"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-invokespecial"]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?class]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Text" ?method]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Tuple" ?classes]]] @@ -291,133 +291,133 @@ (&&host/analyse-jvm-invokespecial analyse ?class ?method ?classes ?object ?args) ;; Exceptions - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-try"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-try"]]]] ["lux;Cons" [?body ?handlers]]]]]]]] (&&host/analyse-jvm-try analyse ?body (&/fold parse-handler [(list) nil] ?handlers)) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-throw"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-throw"]]]] ["lux;Cons" [?ex ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-throw analyse ?ex) ;; Syncronization/monitos - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-monitorenter"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-monitorenter"]]]] ["lux;Cons" [?monitor ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-monitorenter analyse ?monitor) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-monitorexit"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-monitorexit"]]]] ["lux;Cons" [?monitor ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-monitorexit analyse ?monitor) ;; Primitive conversions - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-d2f"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-d2f"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-d2f analyse ?value) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-d2i"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-d2i"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-d2i analyse ?value) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-d2l"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-d2l"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-d2l analyse ?value) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-f2d"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-f2d"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-f2d analyse ?value) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-f2i"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-f2i"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-f2i analyse ?value) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-f2l"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-f2l"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-f2l analyse ?value) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-i2b"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-i2b"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-i2b analyse ?value) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-i2c"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-i2c"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-i2c analyse ?value) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-i2d"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-i2d"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-i2d analyse ?value) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-i2f"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-i2f"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-i2f analyse ?value) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-i2l"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-i2l"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-i2l analyse ?value) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-i2s"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-i2s"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-i2s analyse ?value) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-l2d"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-l2d"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-l2d analyse ?value) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-l2f"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-l2f"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-l2f analyse ?value) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-l2i"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-l2i"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-l2i analyse ?value) ;; Bitwise operators - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-iand"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-iand"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-iand analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-ior"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-ior"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-ior analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-land"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-land"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-land analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-lor"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-lor"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-lor analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-lxor"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-lxor"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-lxor analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-lshl"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-lshl"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-lshl analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-lshr"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-lshr"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-lshr analyse ?x ?y) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-lushr"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-lushr"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-lushr analyse ?x ?y) ;; Arrays - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-new-array"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-new-array"]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?class]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Int" ?length]]] ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-new-array analyse ?class ?length) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-aastore"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-aastore"]]]] ["lux;Cons" [?array ["lux;Cons" [["lux;Meta" [_ ["lux;Int" ?idx]]] ["lux;Cons" [?elem ["lux;Nil" _]]]]]]]]]]]]] (&&host/analyse-jvm-aastore analyse ?array ?idx ?elem) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-aaload"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-aaload"]]]] ["lux;Cons" [?array ["lux;Cons" [["lux;Meta" [_ ["lux;Int" ?idx]]] ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-aaload analyse ?array ?idx) ;; Classes & interfaces - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-class"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-class"]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?name]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?super-class]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Tuple" ?fields]]] ["lux;Nil" _]]]]]]]]]]]]] (&&host/analyse-jvm-class analyse ?name ?super-class ?fields) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-interface"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-interface"]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?name]]]] ?members]]]]]]]] (&&host/analyse-jvm-interface analyse ?name ?members) ;; Programs - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-program"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-program"]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?args]]]] ["lux;Cons" [?body ["lux;Nil" _]]]]]]]]]]] diff --git a/src/lux/analyser/base.clj b/src/lux/analyser/base.clj index 9acd37028..4b23f9460 100644 --- a/src/lux/analyser/base.clj +++ b/src/lux/analyser/base.clj @@ -4,7 +4,7 @@ (lux [base :as & :refer [|let |do return fail]] [type :as &type]))) -;; [Resources] +;; [Exports] (defn expr-type [syntax+] ;; (prn 'expr-type syntax+) ;; (prn 'expr-type (aget syntax+ 0)) @@ -26,14 +26,16 @@ [_] (fail "[Analyser Error] Can't expand to other than 1 element."))))) -(defn analyse-2 [analyse el1 el2] - (|do [output (&/flat-map% analyse (&/|list el1 el2))] +(defn analyse-2 [analyse exo-type1 el1 exo-type2 el2] + (|do [output1 (analyse exo-type1 el1) + output2 (analyse exo-type2 el2)] (do ;; (prn 'analyse-2 (aget output 0)) - (matchv ::M/objects [output] - [["lux;Cons" [x ["lux;Cons" [y ["lux;Nil" _]]]]]] - (return [x y]) + (matchv ::M/objects [output1 output2] + [["lux;Cons" [x ["lux;Nil" _]]] + ["lux;Cons" [y ["lux;Nil" _]]]] + (return (&/T x y)) - [_] + [_ _] (fail "[Analyser Error] Can't expand to other than 2 elements."))))) (defn resolved-ident [ident] @@ -42,3 +44,10 @@ &/get-module-name (return ?module))] (return (&/ident->text (&/T module* ?name)))))) + +(defn resolved-ident* [ident] + (|let [[?module ?name] ident] + (|do [module* (if (= "" ?module) + &/get-module-name + (return ?module))] + (return (&/T module* ?name))))) diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj index 7a0fbe510..a9424b50d 100644 --- a/src/lux/analyser/case.clj +++ b/src/lux/analyser/case.clj @@ -22,91 +22,92 @@ (matchv ::M/objects [pattern] [["lux;Meta" [_ pattern*]]] ;; (assert false) - (matchv ::M/objects [pattern*] - [["lux;Symbol" ?ident]] - (|do [=kont (&env/with-local (&/ident->text ?ident) value-type - kont) - idx &env/next-local-idx] - (return (&/T (&/V "StoreTestAC" idx) =kont))) - - [["lux;Bool" ?value]] - (|do [_ (&type/check value-type &type/Bool) - =kont kont] - (return (&/T (&/V "BoolTestAC" ?value) =kont))) - - [["lux;Int" ?value]] - (|do [=kont kont - _ (&type/check value-type &type/Int)] - (return (&/T (&/V "IntTestAC" ?value) =kont))) - - [["lux;Real" ?value]] - (|do [=kont kont - _ (&type/check value-type &type/Real)] - (return (&/T (&/V "RealTestAC" ?value) =kont))) - - [["lux;Char" ?value]] - (|do [=kont kont - _ (&type/check value-type &type/Char)] - (return (&/T (&/V "CharTestAC" ?value) =kont))) - - [["lux;Text" ?value]] - (|do [=kont kont - _ (&type/check value-type &type/Text)] - (return (&/T (&/V "TextTestAC" ?value) =kont))) - - [["lux;Tuple" ?members]] - (&type/with-vars (&/|length ?members) - (fn [=vars] - (|do [_ (&type/check value-type (&/V "lux;TupleT" =vars)) - [=tests =kont] (&/fold (fn [kont* vm] - (|let [[v m] vm] - (|do [[=test [=tests =kont]] (analyse-pattern v m kont*)] - (matchv ::M/objects [=kont] - [["Expression" [?val ?type]]] - (|do [=type (&type/clean v ?type)] - (return (&/T (&/|cons =test =tests) - (&/V "Expression" (&/T ?val =type))))))))) - (|do [=kont kont] - (return (&/T (&/|list) =kont))) - (&/|reverse (&/zip2 =vars ?members)))] - (return (&/T (&/V "TupleTestAC" =tests) =kont))))) - - [["lux;Record" ?fields]] - (&type/with-vars (&/|length ?fields) - (fn [=vars] - (|do [_ (&type/check value-type (&/V "lux;RecordT" (&/zip2 (&/|keys ?fields) =vars))) - [=tests =kont] (&/fold (fn [kont* vm] - (|let [[v [k m]] vm] - (|do [[=test [=tests =kont]] (analyse-pattern v m kont*)] - (matchv ::M/objects [=kont] - [["Expression" [?val ?type]]] - (|do [=type (&type/clean v ?type)] - (return (&/T (&/|put k =test =tests) - (&/V "Expression" (&/T ?val =type))))))))) - (|do [=kont kont] - (return (&/T (&/|table) =kont))) - (&/|reverse (&/zip2 =vars ?fields)))] - (return (&/T (&/V "RecordTestAC" =tests) =kont))))) - - [["lux;Tag" ?ident]] - (|do [=tag (&&/resolved-ident ?ident) - value-type* (resolve-type value-type) - case-type (&type/variant-case =tag value-type*) - [=test =kont] (analyse-pattern case-type (&/V "lux;Meta" (&/T (&/T "" -1 -1) - (&/V "lux;Tuple" (&/|list)))) - kont)] - (return (&/T (&/V "VariantTestAC" (&/T =tag =test)) =kont))) - - [["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Tag" ?ident]]] - ["lux;Cons" [?value - ["lux;Nil" _]]]]]]] - (|do [=tag (&&/resolved-ident ?ident) - value-type* (resolve-type value-type) - case-type (&type/variant-case =tag value-type*) - [=test =kont] (analyse-pattern case-type ?value - kont)] - (return (&/T (&/V "VariantTestAC" (&/T =tag =test)) =kont))) - ))) + (do ;; (prn 'analyse-pattern/pattern* (aget pattern* 0)) + (matchv ::M/objects [pattern*] + [["lux;Symbol" ?ident]] + (|do [=kont (&env/with-local (&/ident->text ?ident) value-type + kont) + idx &env/next-local-idx] + (return (&/T (&/V "StoreTestAC" idx) =kont))) + + [["lux;Bool" ?value]] + (|do [_ (&type/check value-type &type/Bool) + =kont kont] + (return (&/T (&/V "BoolTestAC" ?value) =kont))) + + [["lux;Int" ?value]] + (|do [_ (&type/check value-type &type/Int) + =kont kont] + (return (&/T (&/V "IntTestAC" ?value) =kont))) + + [["lux;Real" ?value]] + (|do [_ (&type/check value-type &type/Real) + =kont kont] + (return (&/T (&/V "RealTestAC" ?value) =kont))) + + [["lux;Char" ?value]] + (|do [_ (&type/check value-type &type/Char) + =kont kont] + (return (&/T (&/V "CharTestAC" ?value) =kont))) + + [["lux;Text" ?value]] + (|do [_ (&type/check value-type &type/Text) + =kont kont] + (return (&/T (&/V "TextTestAC" ?value) =kont))) + + [["lux;Tuple" ?members]] + (matchv ::M/objects [value-type] + [["lux;TupleT" ?member-types]] + (if (not (= (&/|length ?member-types) (&/|length ?members))) + (fail (str "[Analyser error] Pattern-matching mismatch. Require tuple[" (&/|length ?member-types) "]. Given tuple [" (&/|length ?members) "]")) + (|do [[=tests =kont] (&/fold (fn [kont* vm] + (|let [[v m] vm] + (|do [[=test [=tests =kont]] (analyse-pattern v m kont*)] + (return (&/T (&/|cons =test =tests) =kont))))) + (|do [=kont kont] + (return (&/T (&/|list) =kont))) + (&/|reverse (&/zip2 ?member-types ?members)))] + (return (&/T (&/V "TupleTestAC" =tests) =kont)))) + + [_] + (fail "[Analyser Error] Tuple requires tuple-type.")) + + [["lux;Record" ?fields]] + (&type/with-vars (&/|length ?fields) + (fn [=vars] + (|do [_ (&type/check value-type (&/V "lux;RecordT" (&/zip2 (&/|keys ?fields) =vars))) + [=tests =kont] (&/fold (fn [kont* vm] + (|let [[v [k m]] vm] + (|do [[=test [=tests =kont]] (analyse-pattern v m kont*)] + (matchv ::M/objects [=kont] + [["Expression" [?val ?type]]] + (|do [=type (&type/clean v ?type)] + (return (&/T (&/|put k =test =tests) + (&/V "Expression" (&/T ?val =type))))))))) + (|do [=kont kont] + (return (&/T (&/|table) =kont))) + (&/|reverse (&/zip2 =vars ?fields)))] + (return (&/T (&/V "RecordTestAC" =tests) =kont))))) + + [["lux;Tag" ?ident]] + (|do [=tag (&&/resolved-ident ?ident) + value-type* (resolve-type value-type) + case-type (&type/variant-case =tag value-type*) + [=test =kont] (analyse-pattern case-type (&/V "lux;Meta" (&/T (&/T "" -1 -1) + (&/V "lux;Tuple" (&/|list)))) + kont)] + (return (&/T (&/V "VariantTestAC" (&/T =tag =test)) =kont))) + + [["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Tag" ?ident]]] + ["lux;Cons" [?value + ["lux;Nil" _]]]]]]] + (|do [=tag (&&/resolved-ident ?ident) + value-type* (resolve-type value-type) + case-type (&type/variant-case =tag value-type*) + [=test =kont] (analyse-pattern case-type ?value + kont)] + (return (&/T (&/V "VariantTestAC" (&/T =tag =test)) =kont))) + )))) (defn ^:private analyse-branch [analyse exo-type value-type pattern body patterns] (|do [pattern+body (analyse-pattern value-type pattern @@ -115,8 +116,7 @@ (let [compare-kv #(compare (aget %1 0) (aget %2 0))] (defn ^:private merge-total [struct test+body] - (matchv ::M/objects [test+body] - [[test ?body]] + (|let [[test ?body] test+body] (matchv ::M/objects [struct test] [["DefaultTotal" total?] ["StoreTestAC" ?idx]] (return (&/V "DefaultTotal" true)) @@ -191,14 +191,15 @@ (fail "[Pattern-matching error] Inconsistent record-size.")) [["DefaultTotal" total?] ["VariantTestAC" [?tag ?test]]] - (|do [struct (merge-total (&/V "DefaultTotal" total?) (&/T ?test ?body))] - (return (&/V "VariantTotal" (&/T total? (&/|put ?tag struct (&/|table)))))) + (|do [sub-struct (merge-total (&/V "DefaultTotal" total?) + (&/T ?test ?body))] + (return (&/V "VariantTotal" (&/T total? (&/|put ?tag sub-struct (&/|table)))))) [["VariantTotal" [total? ?branches]] ["VariantTestAC" [?tag ?test]]] - (|do [struct (merge-total (or (&/|get ?tag ?branches) - (&/V "DefaultTotal" total?)) - (&/T ?test ?body))] - (return (&/V "VariantTotal" (&/T total? (&/|put ?tag struct ?branches))))) + (|do [sub-struct (merge-total (or (&/|get ?tag ?branches) + (&/V "DefaultTotal" total?)) + (&/T ?test ?body))] + (return (&/V "VariantTotal" (&/T total? (&/|put ?tag sub-struct ?branches))))) )))) (defn ^:private check-totality [value-type struct] @@ -222,17 +223,16 @@ [["TupleTotal" [?total ?structs]]] (if ?total (return true) - (|do [value-type* (resolve-type value-type)] - (matchv ::M/objects [value-type*] - [["lux;TupleT" ?members]] - (|do [totals (&/map% (fn [sv] - (|let [[sub-struct ?member] sv] - (check-totality ?member sub-struct))) - (&/zip2 ?structs ?members))] - (return (&/fold #(and %1 %2) true totals))) + (matchv ::M/objects [value-type] + [["lux;TupleT" ?members]] + (|do [totals (&/map% (fn [sv] + (|let [[sub-struct ?member] sv] + (check-totality ?member sub-struct))) + (&/zip2 ?structs ?members))] + (return (&/fold #(and %1 %2) true totals))) - [_] - (fail "")))) + [_] + (fail ""))) [["RecordTotal" [?total ?structs]]] (if ?total @@ -279,8 +279,10 @@ (analyse-branch analyse exo-type value-type pattern body patterns))) (&/|list) branches) + :let [_ (prn 'PRE_MERGE_TOTALS)] struct (&/fold% merge-total (&/V "DefaultTotal" false) patterns) ? (check-totality value-type struct)] (if ? - (return (&/|reverse patterns)) + ;; (return (&/|reverse patterns)) + (return patterns) (fail "[Pattern-maching error] Pattern-matching is non-total.")))) diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj index 404573de4..b282f806e 100644 --- a/src/lux/analyser/host.clj +++ b/src/lux/analyser/host.clj @@ -23,11 +23,7 @@ (let [input-type (&/V "lux;DataT" <input-class>) output-type (&/V "lux;DataT" <output-class>)] (defn <name> [analyse ?x ?y] - (|do [[=x =y] (&&/analyse-2 analyse ?x ?y) - =x-type (&&/expr-type =x) - =y-type (&&/expr-type =y) - _ (&type/check input-type =x-type) - _ (&type/check input-type =y-type)] + (|do [[=x =y] (&&/analyse-2 analyse input-type ?x input-type ?y)] (return (&/|list (&/V "Expression" (&/T (&/V <output-tag> (&/T =x =y)) output-type))))))) analyse-jvm-iadd "jvm-iadd" "java.lang.Integer" "java.lang.Integer" diff --git a/src/lux/analyser/lambda.clj b/src/lux/analyser/lambda.clj index ae049f50f..553c4ea9b 100644 --- a/src/lux/analyser/lambda.clj +++ b/src/lux/analyser/lambda.clj @@ -1,7 +1,8 @@ (ns lux.analyser.lambda (:require [clojure.core.match :as M :refer [matchv]] clojure.core.match.array - (lux [base :as & :refer [|let |do return fail]]) + (lux [base :as & :refer [|let |do return fail]] + [host :as &host]) (lux.analyser [base :as &&] [env :as &env]))) @@ -20,11 +21,20 @@ (return (&/T scope-name =captured =return))))))))) (defn close-over [scope ident register frame] - ;; (prn 'close-over scope ident register frame) + (prn 'close-over + (&host/location scope) + (&host/location (&/|list ident)) + register + (->> frame (&/get$ "lux;closure") (&/get$ "lux;counter"))) (matchv ::M/objects [register] [["Expression" [_ register-type]]] - (let [register* (&/V "Expression" (&/T (&/V "captured" (&/T scope (->> frame (&/get$ "lux;closure") (&/get$ "lux;counter")) register)) register-type))] + (|let [register* (&/V "Expression" (&/T (&/V "captured" (&/T scope + (->> frame (&/get$ "lux;closure") (&/get$ "lux;counter")) + register)) + register-type)) + [?module ?name] ident + full-name (str ?module ";" ?name)] (&/T register* (&/update$ "lux;closure" #(->> % (&/update$ "lux;counter" inc) - (&/update$ "lux;mappings" (fn [mps] (&/|put ident register* mps)))) + (&/update$ "lux;mappings" (fn [mps] (&/|put full-name register* mps)))) frame))))) diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index 1abc0bcea..f1c7a6035 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -29,18 +29,17 @@ ;; (prn "^^ analyse-tuple ^^") ;; (prn 'analyse-tuple (str "[" (->> ?elems (&/|map &/show-ast) (&/|interpose " ") (&/fold str "")) "]") ;; (&type/show-type exo-type)) - (|do [t-members (matchv ::M/objects [exo-type] - [["lux;TupleT" ?members]] - (return ?members) + (matchv ::M/objects [exo-type] + [["lux;TupleT" ?members]] + (|do [=elems (&/map% (fn [ve] + (|let [[elem-t elem] ve] + (&&/analyse-1 analyse elem-t elem))) + (&/zip2 ?members ?elems))] + (return (&/|list (&/V "Expression" (&/T (&/V "tuple" =elems) + exo-type))))) - [_] - (fail "[Analyser Error] Tuple requires tuple-type.")) - =elems (&/map% (fn [ve] - (|let [[elem-t elem] ve] - (&&/analyse-1 analyse elem-t elem))) - (&/zip2 t-members ?elems))] - (return (&/|list (&/V "Expression" (&/T (&/V "tuple" =elems) - exo-type)))))) + [_] + (fail "[Analyser Error] Tuples require tuple-types."))) (defn analyse-variant [analyse exo-type ident ?value] ;; (prn "^^ analyse-variant ^^") @@ -102,7 +101,7 @@ (if o?? (|do [i?? (&type/is-Type? btype)] (if i?? - (do (println "FOUND TWO TYPES!") + (do ;; (println "FOUND TWO TYPES!") (return (&/|list binding))) (fail "[Type Error] Types don't match."))) (|do [_ (&type/check exo-type btype)] @@ -136,7 +135,7 @@ [=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)] + [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$ "lux;locals") (&/get$ "lux;mappings") (&/|get local-ident)) (->> top-outer (&/get$ "lux;closure") (&/get$ "lux;mappings") (&/|get local-ident))) @@ -151,25 +150,42 @@ )) (defn ^:private analyse-apply* [analyse exo-type =fn ?args] - (|do [=args (&/map% (fn [arg] (analyse-1+ analyse arg)) - ?args) - =fn-type (&&/expr-type =fn) - [=apply =output-type] (&/fold% (fn [[=fn =fn-type] =input] - (|do [;; :let [_ (prn "#2")] - =input-type (&&/expr-type =input) - ;; :let [_ (prn "#3")] - =output-type (&type/apply-lambda =fn-type =input-type) - ;; :let [_ (prn "#4")] - ] - (return [(&/V "Expression" (&/T (&/V "apply" (&/T =fn =input)) - =output-type)) - =output-type]))) - [=fn =fn-type] - =args) - _ (&type/check exo-type =output-type)] - (matchv ::M/objects [=apply] - [["Expression" [?expr _]]] - (return (&/|list (&/V "Expression" (&/T ?expr exo-type))))))) + (prn 'analyse-apply*/exo-type (&type/show-type exo-type)) + (matchv ::M/objects [=fn] + [["Statement" _]] + (fail "[Analyser Error] Can't apply a statement!") + + [["Expression" [?fun-expr ?fun-type]]] + (matchv ::M/objects [?args] + [["lux;Nil" _]] + (|do [_ (&type/check exo-type ?fun-type)] + (return (&/|list =fn))) + + [["lux;Cons" [?arg ?args*]]] + (do (prn 'analyse-apply*/=fn (&type/show-type ?fun-type)) + (matchv ::M/objects [?fun-type] + [["lux;AllT" _]] + (&type/with-var + (fn [$var] + (|do [type* (&type/apply-type ?fun-type $var) + output (analyse-apply* analyse exo-type (&/V "Expression" (&/T ?fun-expr type*)) ?args)] + (matchv ::M/objects [output] + [["lux;Cons" [["Expression" [?expr* ?type*]] ["lux;Nil" _]]]] + (|do [type** (&type/clean $var ?type*)] + (return (&/|list (&/V "Expression" (&/T ?expr* type**))))) + + [_] + (do (prn 'analyse-apply*/output (aget output 0)) + (assert false)))))) + + [["lux;LambdaT" [?input-t ?output-t]]] + (|do [=arg (&&/analyse-1 analyse ?input-t ?arg)] + (return (&/|list (&/V "Expression" (&/T (&/V "apply" (&/T =fn =arg)) + ?output-t))))) + + [_] + (fail "[Analyser Error] Can't apply a non-function."))) + ))) (defn analyse-apply [analyse exo-type =fn ?args] ;; (prn 'analyse-apply1 (aget =fn 0)) @@ -183,12 +199,13 @@ (if macro? (let [macro-class (&host/location (&/|list ?module ?name))] (|do [macro-expansion (¯o/expand loader macro-class ?args) - output (&/flat-map% analyse macro-expansion)] + :let [_ (prn 'EXPANDING (&type/show-type exo-type))] + output (&/flat-map% (partial analyse exo-type) macro-expansion)] (return output))) (analyse-apply* analyse exo-type =fn ?args))) [_] - (analyse-apply* analyse =fn ?args))) + (analyse-apply* analyse exo-type =fn ?args))) [_] (fail "[Analyser Error] Can't call a statement!")) @@ -217,7 +234,7 @@ (return (&/V "Expression" (&/T (&/V "lambda" (&/T =scope =captured =body)) exo-type)))) [_] - (fail "[Analyser Error] Functions require function types."))) + (fail (str "[Analyser Error] Functions require function types: " (&type/show-type exo-type))))) (defn analyse-lambda** [analyse exo-type ?self ?arg ?body] (prn 'analyse-lambda**/&& (aget exo-type 0)) @@ -241,10 +258,9 @@ (|do [output (analyse-lambda** analyse exo-type ?self ?arg ?body)] (return (&/|list output)))) -(defn analyse-def [analyse exo-type ?name ?value] +(defn analyse-def [analyse ?name ?value] (prn 'analyse-def/CODE ?name (&/show-ast ?value)) - (|do [_ (&type/check exo-type &type/Nothing) - module-name &/get-module-name + (|do [module-name &/get-module-name ? (&&def/defined? module-name ?name)] (if ? (fail (str "[Analyser Error] Can't redefine " ?name)) @@ -260,34 +276,34 @@ ] (return (&/|list (&/V "Statement" (&/V "def" (&/T ?name =value))))))))) -(defn analyse-declare-macro [exo-type ident] - (|let [[?module ?name] ident] - (|do [module-name &/get-module-name] - (if (= ?module module-name) - (|do [_ (&&def/declare-macro ?module ?name)] - (return (&/|list))) - (fail "Can't declare macros from foreign modules."))))) +(defn analyse-declare-macro [ident] + (|do [current-module &/get-module-name + :let [_ (prn 'analyse-declare-macro/current-module current-module)] + [?module ?name] (&&/resolved-ident* ident) + :let [_ (prn 'analyse-declare-macro '[?module ?name] [?module ?name])]] + (if (= ?module current-module) + (|do [_ (&&def/declare-macro ?module ?name)] + (return (&/|list))) + (fail "Can't declare macros from foreign modules.")))) (defn analyse-import [analyse exo-type ?path] (assert false) (return (&/|list))) (defn analyse-check [analyse eval! exo-type ?type ?value] - (println "analyse-check#0") + ;; (println "analyse-check#0") (|do [=type (&&/analyse-1 analyse &type/Type ?type) ;; =type (analyse-1+ analyse ?type) - :let [_ (println "analyse-check#1")] + ;; :let [_ (println "analyse-check#1")] ==type (eval! =type) _ (&type/check exo-type ==type) - :let [_ (println "analyse-check#4" (&type/show-type ==type))] + ;; :let [_ (println "analyse-check#4" (&type/show-type ==type))] =value (&&/analyse-1 analyse ==type ?value) - :let [_ (println "analyse-check#5")]] + ;; :let [_ (println "analyse-check#5")] + ] (matchv ::M/objects [=value] [["Expression" [?expr ?expr-type]]] - (|do [:let [_ (println "analyse-check#6" (&type/show-type ?expr-type))] - ;; _ (&type/check ==type ?expr-type) - :let [_ (println "analyse-check#7")]] - (return (&/|list (&/V "Expression" (&/T ?expr ==type)))))))) + (return (&/|list (&/V "Expression" (&/T ?expr ==type))))))) (defn analyse-coerce [analyse eval! exo-type ?type ?value] (|do [=type (&&/analyse-1 analyse &type/Type ?type) diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index 352a69a3a..9576fc1a2 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -328,7 +328,7 @@ (fail "[Compiler Error] Can't compile expressions as top-level forms."))) (defn ^:private eval! [expr] - (prn 'eval! (aget expr 0)) + ;; (prn 'eval! (aget expr 0)) ;; (assert false) (|do [eval-ctor &/get-eval-ctor :let [class-name (str eval-ctor) diff --git a/src/lux/compiler/case.clj b/src/lux/compiler/case.clj index 0a24c5953..8f737af20 100644 --- a/src/lux/compiler/case.clj +++ b/src/lux/compiler/case.clj @@ -20,7 +20,7 @@ +oclass+ (&host/->class "java.lang.Object") +equals-sig+ (str "(" (&host/->type-signature "java.lang.Object") ")Z")] (defn ^:private compile-match [writer ?match $target $else] - (prn 'compile-match (aget ?match 0) $target $else) + ;; (prn 'compile-match (aget ?match 0) $target $else) (matchv ::M/objects [?match] [["StoreTestAC" ?idx]] (doto writer diff --git a/src/lux/compiler/lambda.clj b/src/lux/compiler/lambda.clj index c75ec4806..332f9804b 100644 --- a/src/lux/compiler/lambda.clj +++ b/src/lux/compiler/lambda.clj @@ -39,7 +39,8 @@ (-> (doto (.visitVarInsn Opcodes/ALOAD 0) (.visitVarInsn Opcodes/ALOAD (inc ?captured-id)) (.visitFieldInsn Opcodes/PUTFIELD class-name captured-name clo-field-sig)) - (->> (let [captured-name (str &&/closure-prefix ?captured-id)]) + (->> (let [captured-name (str &&/closure-prefix ?captured-id) + _ (prn 'add-lambda-<init> class-name ?captured-id)]) (matchv ::M/objects [?name+?captured] [[?name ["Expression" [["captured" [_ ?captured-id ?source]] _]]]]) (doseq [?name+?captured (&/->seq env)]))) diff --git a/src/lux/type.clj b/src/lux/type.clj index ed5e2be24..1e64bc235 100644 --- a/src/lux/type.clj +++ b/src/lux/type.clj @@ -57,16 +57,16 @@ (defn deref [id] (fn [state] (let [mappings (->> state (&/get$ "lux;types") (&/get$ "lux;mappings"))] - (do (prn 'deref/mappings (&/->seq (&/|keys mappings))) - (if-let [type* (->> mappings (&/|get id))] - (do ;; (prn 'deref/type* (aget type* 0)) - (matchv ::M/objects [type*] - [["lux;Some" type]] - (return* state type) - - [["lux;None" _]] - (fail* (str "[Type Error] Unbound type-var: " id)))) - (fail* (str "[Type Error] Unknown type-var: " id))))))) + (do ;; (prn 'deref/mappings (&/->seq (&/|keys mappings))) + (if-let [type* (->> mappings (&/|get id))] + (do ;; (prn 'deref/type* (aget type* 0)) + (matchv ::M/objects [type*] + [["lux;Some" type]] + (return* state type) + + [["lux;None" _]] + (fail* (str "[Type Error] Unbound type-var: " id)))) + (fail* (str "[Type Error] Unknown type-var: " id))))))) (defn set-var [id type] (fn [state] @@ -96,10 +96,10 @@ (defn ^:private delete-var [id] (fn [state] - (prn 'delete-var id) + ;; (prn 'delete-var id) (if-let [tvar (->> state (&/get$ "lux;types") (&/get$ "lux;mappings") (&/|get id))] (return* (&/update$ "lux;types" #(->> % - ;; (&/update$ "lux;counter" dec) + (&/update$ "lux;counter" dec) (&/update$ "lux;mappings" (fn [ms] (&/|remove id ms)))) state) nil) @@ -422,7 +422,7 @@ [["lux;AppT" [F A]] _] (let [fp-pair (&/T expected actual) ;; _ (prn 'LEFT_APP (&/|length fixpoints)) - _ (when (> (&/|length fixpoints) 10) + _ (when (> (&/|length fixpoints) 20) (println 'FIXPOINTS (->> (&/|keys fixpoints) (&/|map (fn [pair] (|let [[e a] pair] |