diff options
| -rw-r--r-- | source/lux.lux | 1999 | ||||
| -rw-r--r-- | src/lux/analyser.clj | 110 | ||||
| -rw-r--r-- | src/lux/analyser/base.clj | 4 | ||||
| -rw-r--r-- | src/lux/analyser/lux.clj | 150 | ||||
| -rw-r--r-- | src/lux/base.clj | 5 | ||||
| -rw-r--r-- | src/lux/lexer.clj | 10 | ||||
| -rw-r--r-- | src/lux/type.clj | 87 |
7 files changed, 1268 insertions, 1097 deletions
diff --git a/source/lux.lux b/source/lux.lux index db579f2d8..faec7869a 100644 --- a/source/lux.lux +++ b/source/lux.lux @@ -74,921 +74,1079 @@ #Nil])])])])])])])])])])]))]) #NothingT])))) -## (deftype (Maybe a) -## (| #None -## (#Some a))) -(def' Maybe - (#AllT [#Nil "Maybe" "a" - (#VariantT (#Cons [["lux;None" (#TupleT #Nil)] - (#Cons [["lux;Some" (#BoundT "a")] - #Nil])]))])) - -## (deftype (Bindings k v) -## (& #counter Int -## #mappings (List (, k v)))) -(def' Bindings - (#AllT [#Nil "Bindings" "k" - (#AllT [#Nil "" "v" - (#RecordT (#Cons [["lux;counter" Int] - (#Cons [["lux;mappings" (#AppT [List - (#TupleT (#Cons [(#BoundT "k") - (#Cons [(#BoundT "v") - #Nil])]))])] - #Nil])]))])])) - -## (deftype (Env k v) -## (& #name Text -## #inner-closures Int -## #locals (Bindings k v) -## #closure (Bindings k v))) -(def' Env - (#AllT [#Nil "Env" "k" - (#AllT [#Nil "" "v" - (#RecordT (#Cons [["lux;name" Text] - (#Cons [["lux;inner-closures" Int] - (#Cons [["lux;locals" (#AppT [(#AppT [Bindings (#BoundT "k")]) - (#BoundT "v")])] - (#Cons [["lux;closure" (#AppT [(#AppT [Bindings (#BoundT "k")]) - (#BoundT "v")])] - #Nil])])])]))])])) - -## (deftype Cursor -## (, Text Int Int)) -(def' Cursor - (#TupleT (#Cons [Text (#Cons [Int (#Cons [Int #Nil])])]))) - -## (deftype (Meta m v) -## (| (#Meta (, m v)))) -(def' Meta - (#AllT [#Nil "Meta" "m" - (#AllT [#Nil "" "v" - (#VariantT (#Cons [["lux;Meta" (#TupleT (#Cons [(#BoundT "m") - (#Cons [(#BoundT "v") - #Nil])]))] - #Nil]))])])) - +## ## (deftype (Maybe a) +## ## (| #None +## ## (#Some a))) +## (def' Maybe +## (#AllT [#Nil "Maybe" "a" +## (#VariantT (#Cons [["lux;None" (#TupleT #Nil)] +## (#Cons [["lux;Some" (#BoundT "a")] +## #Nil])]))])) + +## ## (deftype (Bindings k v) +## ## (& #counter Int +## ## #mappings (List (, k v)))) +## (def' Bindings +## (#AllT [#Nil "Bindings" "k" +## (#AllT [#Nil "" "v" +## (#RecordT (#Cons [["lux;counter" Int] +## (#Cons [["lux;mappings" (#AppT [List +## (#TupleT (#Cons [(#BoundT "k") +## (#Cons [(#BoundT "v") +## #Nil])]))])] +## #Nil])]))])])) + +## ## (deftype (Env k v) +## ## (& #name Text +## ## #inner-closures Int +## ## #locals (Bindings k v) +## ## #closure (Bindings k v))) +## (def' Env +## (#AllT [#Nil "Env" "k" +## (#AllT [#Nil "" "v" +## (#RecordT (#Cons [["lux;name" Text] +## (#Cons [["lux;inner-closures" Int] +## (#Cons [["lux;locals" (#AppT [(#AppT [Bindings (#BoundT "k")]) +## (#BoundT "v")])] +## (#Cons [["lux;closure" (#AppT [(#AppT [Bindings (#BoundT "k")]) +## (#BoundT "v")])] +## #Nil])])])]))])])) + +## ## (deftype Cursor +## ## (, Text Int Int)) +## (def' Cursor +## (#TupleT (#Cons [Text (#Cons [Int (#Cons [Int #Nil])])]))) + +## ## (deftype (Meta m v) +## ## (| (#Meta (, m v)))) +## (def' Meta +## (#AllT [#Nil "Meta" "m" +## (#AllT [#Nil "" "v" +## (#VariantT (#Cons [["lux;Meta" (#TupleT (#Cons [(#BoundT "m") +## (#Cons [(#BoundT "v") +## #Nil])]))] +## #Nil]))])])) + +## ## (def' Reader +## ## (List (Meta Cursor Text))) ## (def' Reader -## (List (Meta Cursor Text))) -(def' Reader - (#AppT [List - (#AppT [(#AppT [Meta Cursor]) - Text])])) - -## (deftype CompilerState -## (& #source (Maybe Reader) -## #modules (List Any) -## #module-aliases (List Any) -## #global-env (Maybe (Env Text Any)) -## #local-envs (List (Env Text Any)) -## #types (Bindings Int Type) -## #writer (^ org.objectweb.asm.ClassWriter) -## #loader (^ java.net.URLClassLoader) -## #eval-ctor Int)) -(def' CompilerState - (#RecordT (#Cons [["lux;source" (#AppT [Maybe Reader])] - (#Cons [["lux;modules" (#AppT [List Any])] - (#Cons [["lux;module-aliases" (#AppT [List Any])] - (#Cons [["lux;global-env" (#AppT [Maybe (#AppT [(#AppT [Env Text]) Any])])] - (#Cons [["lux;local-envs" (#AppT [List (#AppT [(#AppT [Env Text]) Any])])] - (#Cons [["lux;types" (#AppT [(#AppT [Bindings Int]) Type])] - (#Cons [["lux;writer" (#DataT ["org.objectweb.asm.ClassWriter" #Nil])] - (#Cons [["lux;loader" (#DataT ["java.lang.ClassLoader" #Nil])] - (#Cons [["lux;eval-ctor" Int] - #Nil])])])])])])])])]))) - -## (deftype #rec Syntax -## (Meta Cursor (| (#Bool Bool) -## (#Int Int) -## (#Real Real) -## (#Char Char) -## (#Text Text) -## (#Form (List Syntax)) -## (#Tuple (List Syntax)) -## (#Record (List (, Text Syntax)))))) -(def' Syntax - (case' (#AppT [(#BoundT "Syntax") (#BoundT "")]) - Syntax - (case' (#AppT [List Syntax]) - SyntaxList - (#AppT [(#AllT [#Nil "Syntax" "" - (#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])))) +## (#AppT [List +## (#AppT [(#AppT [Meta Cursor]) +## Text])])) + +## ## (deftype CompilerState +## ## (& #source (Maybe Reader) +## ## #modules (List Any) +## ## #module-aliases (List Any) +## ## #global-env (Maybe (Env Text Any)) +## ## #local-envs (List (Env Text Any)) +## ## #types (Bindings Int Type) +## ## #writer (^ org.objectweb.asm.ClassWriter) +## ## #loader (^ java.net.URLClassLoader) +## ## #eval-ctor Int)) +## (def' CompilerState +## (#RecordT (#Cons [["lux;source" (#AppT [Maybe Reader])] +## (#Cons [["lux;modules" (#AppT [List Any])] +## (#Cons [["lux;module-aliases" (#AppT [List Any])] +## (#Cons [["lux;global-env" (#AppT [Maybe (#AppT [(#AppT [Env Text]) Any])])] +## (#Cons [["lux;local-envs" (#AppT [List (#AppT [(#AppT [Env Text]) Any])])] +## (#Cons [["lux;types" (#AppT [(#AppT [Bindings Int]) Type])] +## (#Cons [["lux;writer" (#DataT ["org.objectweb.asm.ClassWriter" #Nil])] +## (#Cons [["lux;loader" (#DataT ["java.lang.ClassLoader" #Nil])] +## (#Cons [["lux;eval-ctor" Int] +## #Nil])])])])])])])])]))) + +## ## (deftype #rec Syntax +## ## (Meta Cursor (| (#Bool Bool) +## ## (#Int Int) +## ## (#Real Real) +## ## (#Char Char) +## ## (#Text Text) +## ## (#Form (List Syntax)) +## ## (#Tuple (List Syntax)) +## ## (#Record (List (, Text Syntax)))))) +## (def' Syntax +## (case' (#AppT [(#BoundT "Syntax") (#BoundT "")]) +## Syntax +## (case' (#AppT [List Syntax]) +## SyntaxList +## (#AppT [(#AllT [#Nil "Syntax" "" +## (#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 Macro -## (-> (List Syntax) CompilerState -## [CompilerState (List Syntax)])) -(def' Macro - (case' (#AppT [List Syntax]) - SyntaxList - (#LambdaT [SyntaxList - (#LambdaT [CompilerState - (#TupleT (#Cons [CompilerState (#Cons [SyntaxList #Nil])]))])]))) - -## Base functions & macros -## (def (_meta data) -## (All [a] (-> a (Meta Cursor a))) -## (#Meta [["" -1 -1] data])) -(def' _meta - (check' (#AllT [#Nil "" "a" - (#LambdaT [(#BoundT "a") - (#AppT [(#AppT [Meta Cursor]) - (#BoundT "a")])])]) - (lambda' _ data - (#Meta [["" -1 -1] data])))) +## ## (deftype (Either l r) +## ## (| (#Left l) +## ## (#Right r))) +## (def' Either +## (#AllT [#Nil "Either" "l" +## (#AllT [#Nil "" "r" +## (#VariantT (#Cons [["lux;Left" (#BoundT "l")] +## (#Cons [["lux;Right" (#BoundT "r")] +## #Nil])]))])])) +## ## (deftype Macro +## ## (-> (List Syntax) CompilerState +## ## (Either Text [CompilerState (List Syntax)]))) +## (def' Macro +## (case' (#AppT [List Syntax]) +## SyntaxList +## (#LambdaT [SyntaxList +## (#LambdaT [CompilerState +## (#AppT [(#AppT [Either Text]) +## (#TupleT (#Cons [CompilerState +## (#Cons [SyntaxList #Nil])]))])])]))) + +## ## Base functions & macros +## ## (def (_meta data) +## ## (All [a] (-> a (Meta Cursor a))) +## ## (#Meta [["" -1 -1] data])) +## (def' _meta +## (check' (#AllT [#Nil "" "a" +## (#LambdaT [(#BoundT "a") +## (#AppT [(#AppT [Meta Cursor]) +## (#BoundT "a")])])]) +## (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' 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])])) -## )))) -## (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])])])))) -## (#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 [body -## #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) -## (jvm-ladd x y)) - -## (def (id x) -## x) - -## (def (print x) -## (jvm-invokevirtual java.io.PrintStream "print" [java.lang.Object] -## (jvm-getstatic java.lang.System "out") [x])) - -## (def (println x) -## (jvm-invokevirtual java.io.PrintStream "println" [java.lang.Object] -## (jvm-getstatic java.lang.System "out") [x])) - -## (def (fold f init xs) -## (case' xs -## #Nil -## init - -## (#Cons [x xs']) -## (fold f (f init x) xs'))) - -## (def (reverse list) -## (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) -## (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) -## (lambda [x] (f (g x)))) - -## (def (++ xs ys) -## (case' xs -## #Nil -## ys - -## (#Cons [x xs']) -## (#Cons [x (++ xs' ys)]))) - -## (def concat -## (fold ++ #Nil)) - -## (def (map f xs) -## (case' xs -## #Nil -## #Nil - -## (#Cons [x xs']) -## (#Cons [(f x) (map f xs')]))) - -## (def flat-map (. 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) -## (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) -## (case' xs -## #Nil -## #Nil - -## (#Cons [x xs']) -## (if (p x) -## (#Cons [x (filter p xs')]) -## (filter p xs')))) - -## (def (return val) -## (lambda [state] -## (#Right [state val]))) - -## (def (fail msg) -## (lambda [_] -## (#Left msg))) - -## (def (bind f v) -## (lambda [state] -## (case' (v state) -## (#Right [state' x]) -## (f x state') - -## (#Left msg) -## (#Left msg)))) - -## (def (first pair) -## (case' pair -## [f s] -## f)) - -## (def (second pair) -## (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) -## (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) -## (lambda [_] x)) - -## (def (int> x y) -## (jvm-lgt x y)) - -## (def (int< x y) -## (jvm-llt x y)) - -## (def inc (int+ 1)) -## (def dec (int+ -1)) - -## (def (repeat n x) -## (if (int> n 0) -## (#Cons [x (repeat (dec n) x)]) -## #Nil)) - -## (def size -## (fold (lambda [acc _] (inc acc)) 0)) - -## (def (last xs) -## (case' xs -## #Nil #None -## (#Cons [x #Nil]) (#Some x) -## (#Cons [_ xs']) (last xs'))) - -## (def (init xs) -## (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) -## (case' [xs ys] -## [(#Cons [x xs']) (#Cons [y ys'])] -## (list+ x y (interleave xs' ys')) - -## _ -## #Nil)) - -## (def (interpose sep xs) -## (case' xs -## #Nil -## xs - -## (#Cons [x #Nil]) -## xs - -## (#Cons [x xs']) -## (list+ x sep (interpose sep xs')))) - -## (def (empty? xs) -## (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) -## (if (int< from to) -## (#Cons [from (range (inc from) to)]) -## #Nil)) - -## (def (tuple->list tuple) -## (case' tuple -## (#Meta [_ (#Tuple list)]) -## list)) - -## (def (zip2 xs ys) -## (case' [xs ys] -## [(#Cons [x xs']) (#Cons [y ys'])] -## (#Cons [[x y] (zip2 xs' ys')]) - -## _ -## #Nil)) - -## (def (get key map) -## (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) -## (case' x -## (#Meta [_ (#Symbol [_ ident])]) -## ident)) - -## (def (text-++ x y) -## (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-template tokens) -## (case' tokens -## (#Cons [bindings (#Cons [template data])]) -## (let [bindings-list (map get-ident (tuple->list bindings)) -## data-lists (map tuple->list data) -## apply (lambda [env] (apply-template env template))] -## (|> data-lists -## (map (. apply (zip2 bindings-list))) -## return)))) - -## ## ## ## (do-template [<name> <offset>] -## ## ## ## (def <name> (int+ <offset>)) - -## ## ## ## [inc 1] -## ## ## ## [dec -1]) - -## (def (int= x y) -## (jvm-leq x y)) - -## (def (int% x y) -## (jvm-lrem x y)) - -## (def (int>= x y) -## (or (int= x y) -## (int> x y))) - -## (do-template [<name> <cmp>] -## (def (<name> x y) -## (if (<cmp> x y) -## x -## y)) - -## [max int>] -## [min int<]) - -## (do-template [<name> <cmp>] -## (def (<name> n) (<cmp> n 0)) - -## [neg? int<] -## [pos? int>=]) - -## (def (even? n) -## (int= 0 (int% n 0))) - -## (def (odd? n) -## (not (even? n))) - -## (do-template [<name> <done> <step>] -## (def (<name> n xs) -## (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-template [<name> <done> <step>] -## (def (<name> f xs) -## (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))) +## (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') + +## ## ## (All 21268 +## ## ## (-> 21268 +## ## ## (All 21267 +## ## ## (-> 21267 +## ## ## (| (#lux;Right (, 21267 +## ## ## (| (#lux;Cons (, (((All Meta m (All v (| (#lux;Meta (, m v))))) +## ## ## (, (^ java.lang.String []) (^ java.lang.Long []) (^ java.lang.Long []))) +## ## ## ⌈17⌋) +## ## ## (| (#lux;Nil (, ))))))))))))) + +## ## (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))]))) -## (#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) -## (jvm-invokevirtual java.lang.Object "toString" [] -## int [])) +## ## (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) -## ## (#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) -## (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 [_ (#Tuple bindings)]) (#Cons [body #Nil])]) -## (let [output (fold (lambda [body binding] -## (case' binding -## [lhs rhs] -## (` (bind (lambda [(~ lhs)] (~ body)) -## (~ rhs))))) -## body -## (reverse (as-pairs bindings)))] -## (return (list output))))) - -## (def (map% f xs) -## (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))) (list)])))) - -## (#Cons [(#Meta [_ (#Symbol [_ class-name])]) (#Cons [(#Meta [_ (#Tuple params)]) #Nil])]) -## (return (list (` (#DataT [(~ (_meta (#Text class-name))) (~ (untemplate-list params))])))))) - -## (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) -## (jvm-invokevirtual java.lang.Object "equals" [java.lang.Object] -## x [y])) - -## (def (replace-ident ident value 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)) +## ## [(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))) (list)])))) + +## ## (#Cons [(#Meta [_ (#Symbol [_ class-name])]) (#Cons [(#Meta [_ (#Tuple params)]) #Nil])]) +## ## (return (list (` (#DataT [(~ (_meta (#Text class-name))) (~ (untemplate-list params))])))))) + +## ## (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 @@ -1026,6 +1184,7 @@ ## ## (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)] @@ -1120,20 +1279,20 @@ ## ## (= x y))) ## ## (zip2 xs ys))))) -## ## (def (with tokens) -## ## ...) +## ## ## ## (def (with tokens) +## ## ## ## ...) -## ## TODO: Full pattern-matching -## ## TODO: Type-related macros -## ## TODO: (Im|Ex)ports-related macros -## ## TODO: Macro-related macros +## ## ## ## 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") +## ## ## ## (import "lux") +## ## ## ## (module-alias "lux" "l") +## ## ## ## (def-alias "lux;map" "map") -## ## (def (require tokens) -## ## (case tokens -## ## ...)) +## ## ## ## (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 9ed75b83d..80f2cd252 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -2,7 +2,7 @@ (:require (clojure [template :refer [do-template]]) [clojure.core.match :as M :refer [matchv]] clojure.core.match.array - (lux [base :as & :refer [exec return fail]] + (lux [base :as & :refer [exec return fail |list]] [reader :as &reader] [parser :as &parser] [type :as &type] @@ -15,19 +15,22 @@ ;; [Utils] (defn ^:private parse-handler [[catch+ finally+] token] (matchv ::M/objects [token] - [["lux;Meta" [meta ["Form" ["Cons" [["lux;Meta" [_ ["Symbol" [_ "jvm-catch"]]]] - ["Cons" [["lux;Meta" [_ ["Symbol" [_ ?ex-class]]]] - ["Cons" [["lux;Meta" [_ ["Symbol" [_ ?ex-arg]]]] - ["Cons" [?catch-body - ["Nil" _]]]]]]]]]]]]] - [(concat catch+ (list [?ex-class ?ex-arg ?catch-body])) finally+] - - [["lux;Meta" [meta ["Form" ["Cons" [["lux;Meta" [_ ["Symbol" [_ "jvm-finally"]]]] - ["Cons" [?finally-body - ["Nil" _]]]]]]]]] - [catch+ ?finally-body])) - -(defn ^:private analyse-basic-ast [analyse eval! token] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-catch"]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?ex-class]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?ex-arg]]]] + ["lux;Cons" [?catch-body + ["lux;Nil" _]]]]]]]]]]]]] + (&/T (&/|++ catch+ (|list (&/T ?ex-class ?ex-arg ?catch-body))) finally+) + + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-finally"]]]] + ["lux;Cons" [?finally-body + ["lux;Nil" _]]]]]]]]] + (&/T catch+ ?finally-body))) + +(defn ^:private _meta [token] + (&/V "lux;Meta" (&/T (&/T "" -1 -1) token))) + +(defn ^:private analyse-basic-ast [analyse eval! exo-type token] ;; (prn 'analyse-basic-ast (aget token 0)) ;; (when (= "lux;Tag" (aget token 0)) ;; (prn 'analyse-basic-ast/tag (aget token 1))) @@ -35,37 +38,34 @@ (matchv ::M/objects [token] ;; Standard special forms [["lux;Meta" [meta ["lux;Bool" ?value]]]] - (return (&/|list (&/V "Expression" (&/T (&/V "bool" ?value) (&/V "lux;DataT" (&/T "java.lang.Boolean" (&/V "lux;Nil" nil))))))) + (return (&/|list (&/V "Expression" (&/T (&/V "bool" ?value) (&/V "lux;DataT" (&/T "java.lang.Boolean" (|list))))))) [["lux;Meta" [meta ["lux;Int" ?value]]]] - (return (&/|list (&/V "Expression" (&/T (&/V "int" ?value) (&/V "lux;DataT" (&/T "java.lang.Long" (&/V "lux;Nil" nil))))))) + (return (&/|list (&/V "Expression" (&/T (&/V "int" ?value) (&/V "lux;DataT" (&/T "java.lang.Long" (|list))))))) [["lux;Meta" [meta ["lux;Real" ?value]]]] - (return (&/|list (&/V "Expression" (&/T (&/V "real" ?value) (&/V "lux;DataT" (&/T "java.lang.Double" (&/V "lux;Nil" nil))))))) + (return (&/|list (&/V "Expression" (&/T (&/V "real" ?value) (&/V "lux;DataT" (&/T "java.lang.Double" (|list))))))) [["lux;Meta" [meta ["lux;Char" ?value]]]] - (return (&/|list (&/V "Expression" (&/T (&/V "char" ?value) (&/V "lux;DataT" (&/T "java.lang.Character" (&/V "lux;Nil" nil))))))) + (return (&/|list (&/V "Expression" (&/T (&/V "char" ?value) (&/V "lux;DataT" (&/T "java.lang.Character" (|list))))))) [["lux;Meta" [meta ["lux;Text" ?value]]]] - (return (&/|list (&/V "Expression" (&/T (&/V "text" ?value) (&/V "lux;DataT" (&/T "java.lang.String" (&/V "lux;Nil" nil))))))) + (return (&/|list (&/V "Expression" (&/T (&/V "text" ?value) (&/V "lux;DataT" (&/T "java.lang.String" (|list))))))) [["lux;Meta" [meta ["lux;Tuple" ?elems]]]] - (&&lux/analyse-tuple analyse ?elems) + (&&lux/analyse-tuple analyse exo-type ?elems) [["lux;Meta" [meta ["lux;Record" ?elems]]]] (&&lux/analyse-record analyse ?elems) - [["lux;Meta" [meta ["lux;Tag" [?module ?name]]]]] - (let [tuple-type (&/V "lux;TupleT" (&/V "lux;Nil" nil)) - ?tag (str ?module ";" ?name)] - (return (&/|list (&/V "Expression" (&/T (&/V "variant" (&/T ?tag (&/V "Expression" (&/T (&/V "tuple" (&/|list)) tuple-type)))) - (&/V "lux;VariantT" (&/V "lux;Cons" (&/T (&/T ?tag tuple-type) (&/V "lux;Nil" nil))))))))) - + [["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"]]]]] - (return (&/|list (&/V "Expression" (&/T (&/V "jvm-null" nil) (&/V "lux;DataT" (&/T "null" (&/V "lux;Nil" nil))))))) + (return (&/|list (&/V "Expression" (&/T (&/V "jvm-null" nil) (&/V "lux;DataT" (&/T "null" (|list))))))) [["lux;Meta" [meta ["lux;Symbol" ?ident]]]] - (&&lux/analyse-ident analyse ?ident) + (&&lux/analyse-symbol analyse exo-type ?ident) [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "case'"]]]] ["lux;Cons" [?variant ?branches]]]]]]]] @@ -76,7 +76,7 @@ ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?arg]]]] ["lux;Cons" [?body ["lux;Nil" _]]]]]]]]]]]]] - (&&lux/analyse-lambda analyse ?self ?arg ?body) + (&&lux/analyse-lambda analyse exo-type ?self ?arg ?body) [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "def'"]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?name]]]] @@ -84,7 +84,7 @@ ["lux;Nil" _]]]]]]]]]]] (do ;; (when (= "if" ?name) ;; (prn "if" (&/show-ast ?value))) - (&&lux/analyse-def analyse ?name ?value)) + (&&lux/analyse-def analyse exo-type ?name ?value)) [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "declare-macro'"]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ?ident]]] @@ -100,7 +100,7 @@ ["lux;Cons" [?type ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]]]] - (&&lux/analyse-check analyse eval! ?type ?value) + (&&lux/analyse-check analyse eval! exo-type ?type ?value) [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "coerce'"]]]] ["lux;Cons" [?type @@ -421,34 +421,28 @@ [_] (fail (str "[Analyser Error] Unmatched token: " (&/show-ast token))))) -(defn ^:private analyse-ast [eval!] - (fn [token] - ;; (prn 'analyse-ast token) - (matchv ::M/objects [token] - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Tag" [?module ?name]]]] ?values]]]]]] - (exec [;; :let [_ (prn 'PRE-ASSERT)] - :let [?tag (str ?module ";" ?name)] - :let [_ (assert (= 1 (&/|length ?values)) (str "[Analyser Error] Can only tag 1 value: " (pr-str token)))] - ;; :let [_ (prn 'POST-ASSERT)] - =value (&&/analyse-1 (analyse-ast eval!) (&/|head ?values)) - =value-type (&&/expr-type =value)] - (return (&/|list (&/V "Expression" (&/T (&/V "variant" (&/T ?tag =value)) (&/V "lux;VariantT" (&/V "lux;Cons" (&/T (&/T ?tag =value-type) (&/V "lux;Nil" nil))))))))) - - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [?fn ?args]]]]]] - (fn [state] - ;; (prn '(&/show-ast ?fn) (&/show-ast ?fn)) - (matchv ::M/objects [((&&/analyse-1 (analyse-ast eval!) ?fn) state)] - [["lux;Right" [state* =fn]]] - ((&&lux/analyse-apply (analyse-ast eval!) =fn ?args) state*) - - [_] - (do ;; (prn 'analyse-ast/token (aget token 0) (&/show-state state)) - ((analyse-basic-ast (analyse-ast eval!) eval! token) state)))) - - [_] - (analyse-basic-ast (analyse-ast eval!) eval! token)))) +(defn ^:private analyse-ast [eval! exo-type token] + ;; (prn 'analyse-ast token) + (matchv ::M/objects [token] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Tag" ?ident]]] ?values]]]]]] + (do (assert (= 1 (&/|length ?values)) "[Analyser Error] Can only tag 1 value.") + (&&lux/analyse-variant (partial analyse-ast eval!) exo-type ?ident (&/|head ?values))) + + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [?fn ?args]]]]]] + (fn [state] + ;; (prn '(&/show-ast ?fn) (&/show-ast ?fn)) + (matchv ::M/objects [((&&/analyse-1 (partial analyse-ast eval!) exo-type ?fn) state)] + [["lux;Right" [state* =fn]]] + ((&&lux/analyse-apply (partial analyse-ast eval!) exo-type =fn ?args) state*) + + [_] + (do ;; (prn 'analyse-ast/token (aget token 0) (&/show-state state)) + ((analyse-basic-ast (partial analyse-ast eval!) eval! exo-type token) state)))) + + [_] + (analyse-basic-ast (partial analyse-ast eval!) eval! exo-type token))) ;; [Resources] (defn analyse [eval!] (exec [asts &parser/parse] - (&/flat-map% (analyse-ast eval!) asts))) + (&/flat-map% (partial analyse-ast eval! &type/Nothing) asts))) diff --git a/src/lux/analyser/base.clj b/src/lux/analyser/base.clj index 827d0336e..62ccedb51 100644 --- a/src/lux/analyser/base.clj +++ b/src/lux/analyser/base.clj @@ -16,8 +16,8 @@ [["Statement" _]] (fail (str "[Analyser Error] Can't retrieve the type of a statement: " (pr-str syntax+))))) -(defn analyse-1 [analyse elem] - (exec [output (analyse elem)] +(defn analyse-1 [analyse exo-type elem] + (exec [output (analyse exo-type elem)] (do ;; (prn 'analyse-1 (aget output 0)) (matchv ::M/objects [output] [["lux;Cons" [x ["lux;Nil" _]]]] diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index aa205bf06..e38d10117 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -2,7 +2,7 @@ (:require (clojure [template :refer [do-template]]) [clojure.core.match :as M :refer [matchv]] clojure.core.match.array - (lux [base :as & :refer [exec return return* fail fail* |let]] + (lux [base :as & :refer [exec return return* fail fail* |let |list]] [parser :as &parser] [type :as &type] [macro :as ¯o] @@ -13,15 +13,35 @@ [env :as &&env] [def :as &&def]))) -;; [Resources] -(defn analyse-tuple [analyse ?elems] - (exec [=elems (&/flat-map% analyse ?elems) +(defn ^:private analyse-1+ [analyse] + (fn [?token] + (&&/with-var #(&&/analyse-1 analyse % ?token)))) + +;; [Exports] +(defn analyse-tuple [analyse exo-type ?elems] + (exec [=elems (&/map% (analyse-1+ analyse) ?elems) =elems-types (&/map% &&/expr-type =elems) ;; :let [_ (prn 'analyse-tuple =elems)] + :let [endo-type (&/V "lux;TupleT" =elems-types)] + _ (&type/solve exo-type endo-type) + ;; :let [_ (prn 'analyse-tuple 'DONE)] ] - (return (&/|list (&/V "Expression" (&/T (&/V "tuple" =elems) (&/V "lux;TupleT" =elems-types))))))) + (return (&/|list (&/V "Expression" (&/T (&/V "tuple" =elems) + exo-type)))))) -(defn analyse-record [analyse ?elems] +(defn analyse-variant [analyse exo-type ident ?value] + (|let [[?module ?name] ident + ?tag (str ?module ";" ?name)] + (exec [=value ((analyse-1+ analyse) ?value) + =value-type (&&/expr-type =value) + :let [endo-type (&/V "lux;VariantT" (|list (&/T ?tag =value-type)))] + _ (&type/solve exo-type endo-type) + ;; :let [_ (prn 'analyse-variant 'DONE)] + ] + (return (&/|list (&/V "Expression" (&/T (&/V "variant" (&/T ?tag =value)) + exo-type))))))) + +(defn analyse-record [analyse exo-type ?elems] (exec [=elems (&/map% (fn [kv] (matchv ::M/objects [kv] [[k v]] @@ -38,19 +58,10 @@ ] (return (&/|list (&/V "Expression" (&/T (&/V "lux;record" =elems) (&/V "lux;RecordT" =elems-types))))))) -(defn ^:private resolve-global [ident state] - (|let [[?module ?name] ident - ident* (str ?module ";" ?name)] - (if-let [global (->> state (&/get$ "lux;global-env") &/from-some (&/get$ "lux;locals") (&/get$ "lux;mappings") (&/|get ident*))] - (return* state (&/|list global)) - (fail* (str "[Analyser Error] Unresolved identifier: " ident*))))) - -(defn analyse-ident [analyse ident] +(defn analyse-symbol [analyse exo-type ident] (|let [[?module ?name] ident] (do ;; (prn 'analyse-ident ?module ?name) - (exec [module-name &/get-module-name] - (if (not= module-name ?module) - (partial resolve-global ident) + (exec [module-name &/get-module-name] (fn [state] ;; (when (and (= "lux" ?module) ;; (= "output" ?name)) @@ -59,44 +70,40 @@ ;; (prn '(&/get$ "local-envs" state) (&/get$ "local-envs" state)) ;; (prn '(&/->seq (&/get$ "local-envs" state)) (&/->seq (&/get$ "local-envs" state))) ;; (println (&/show-state state)) - (let [stack (&/get$ "lux;local-envs" state)] - (matchv ::M/objects [stack] + (|let [stack (&/get$ "lux;local-envs" state) + no-binding? #(and (->> % (&/get$ "lux;locals") (&/get$ "lux;mappings") (&/|contains? ?name) not) + (->> % (&/get$ "lux;closure") (&/get$ "lux;mappings") (&/|contains? ?name) not)) + [inner outer] (&/|split-with no-binding? stack)] + (matchv ::M/objects [outer] [["lux;Nil" _]] - (resolve-global ident state) - - [["lux;Cons" [top stack*]]] - (if-let [=bound (or (->> stack &/|head (&/get$ "lux;locals") (&/get$ "lux;mappings") (&/|get ?name)) - (->> stack &/|head (&/get$ "lux;closure") (&/get$ "lux;mappings") (&/|get ?name)))] - (return* state (&/|list =bound)) - (|let [no-binding? #(and (->> % (&/get$ "lux;locals") (&/get$ "lux;mappings") (&/|contains? ?name) not) - (->> % (&/get$ "lux;closure") (&/get$ "lux;mappings") (&/|contains? ?name) not)) - [inner outer] (&/|split-with no-binding? stack*)] - (matchv ::M/objects [outer] - [["lux;Nil" _]] - (resolve-global ident state) - - [["lux;Cons" [top-outer _]]] - (|let [in-stack (&/|cons top inner) - scopes (&/|tail (&/folds #(&/|cons (&/get$ "lux;name" %2) %1) - (&/|map #(&/get$ "lux;name" %) outer) - (&/|reverse in-stack))) - ;; _ (prn 'in-stack module-name ident (&/->seq (&/|map #(&/get$ "name" %) in-stack)) scopes) - [=local inner*] (&/fold (fn [register+new-inner frame+in-scope] - (|let [[register new-inner] register+new-inner - [frame in-scope] frame+in-scope - [register* frame*] (&&lambda/close-over (&/|cons module-name (&/|reverse in-scope)) ?name register frame)] - (&/T register* (&/|cons frame* new-inner)))) - (&/T (or (->> top-outer (&/get$ "lux;locals") (&/get$ "lux;mappings") (&/|get ?name)) - (->> top-outer (&/get$ "lux;closure") (&/get$ "lux;mappings") (&/|get ?name))) - (&/|list)) - (&/zip2 (&/|reverse in-stack) scopes))] - (return* (&/set$ "lux;local-envs" (&/|++ inner* outer) state) (&/|list =local))) - ))) - )) - )) - )))) - -(defn ^:private analyse-apply* [analyse =fn ?args] + (|let [[?module ?name] ident + ident* (str ?module ";" ?name)] + (if-let [global (->> state (&/get$ "lux;global-env") &/from-some (&/get$ "lux;locals") (&/get$ "lux;mappings") (&/|get ident*))] + (&/run-state (exec [=global-type (&&/expr-type global) + _ (&type/solve exo-type =global-type)] + (return (&/|list global))) + state) + (fail* (str "[Analyser Error] Unresolved identifier: " ident*)))) + + [["lux;Cons" [top-outer _]]] + (|let [scopes (&/|tail (&/folds #(&/|cons (&/get$ "lux;name" %2) %1) + (&/|map #(&/get$ "lux;name" %) outer) + (&/|reverse inner))) + ;; _ (prn 'inner module-name ident (&/->seq (&/|map #(&/get$ "name" %) inner)) scopes) + [=local inner*] (&/fold (fn [register+new-inner frame+in-scope] + (|let [[register new-inner] register+new-inner + [frame in-scope] frame+in-scope + [register* frame*] (&&lambda/close-over (&/|cons module-name (&/|reverse in-scope)) ?name register frame)] + (&/T register* (&/|cons frame* new-inner)))) + (&/T (or (->> top-outer (&/get$ "lux;locals") (&/get$ "lux;mappings") (&/|get ?name)) + (->> top-outer (&/get$ "lux;closure") (&/get$ "lux;mappings") (&/|get ?name))) + (&/|list)) + (&/zip2 (&/|reverse inner) scopes))] + (return* (&/set$ "lux;local-envs" (&/|++ inner* outer) state) (&/|list =local))) + ))) + )))) + +(defn ^:private analyse-apply* [analyse exo-type =fn ?args] (exec [=args (&/flat-map% analyse ?args) =fn-type (&&/expr-type =fn) [=apply _] (&/fold% (fn [[=fn =fn-type] =input] @@ -113,7 +120,7 @@ =args)] (return (&/|list =apply)))) -(defn analyse-apply [analyse =fn ?args] +(defn analyse-apply [analyse exo-type =fn ?args] ;; (prn 'analyse-apply1 (aget =fn 0)) (exec [loader &/loader] (matchv ::M/objects [=fn] @@ -136,7 +143,7 @@ (fail "[Analyser Error] Can't call a statement!")) )) -(defn analyse-case [analyse ?value ?branches] +(defn analyse-case [analyse exo-type ?value ?branches] ;; (prn 'analyse-case (aget ?branches 0) (aget ?branches 1 1 0) ;; (&/->seq ?branches)) ;; (prn 'analyse-case (&/show-ast ?value)) @@ -160,12 +167,13 @@ ;; :let [_ (prn '=bodies =bodies)] ;; :let [_ (prn 'analyse-case/=bodies =bodies)] =body-types (&/map% &&/expr-type =bodies) + :let [_ (prn 'analyse-case (->> =body-types (&/|map &type/show-type) (&/|interpose " ") (&/fold str "")))] =case-type (&/fold% &type/merge (&/V "lux;NothingT" nil) =body-types) :let [=branches (&/zip2 (&/|map &/|first branches) =bodies)]] (return (&/|list (&/V "Expression" (&/T (&/V "case" (&/T =value base-register max-locals =branches)) =case-type)))))) -(defn analyse-lambda [analyse ?self ?arg ?body] +(defn analyse-lambda [analyse exo-type ?self ?arg ?body] ;; (prn 'analyse-lambda ?self ?arg ?body) (exec [=lambda-type* &type/fresh-lambda] (matchv ::M/objects [=lambda-type*] @@ -192,18 +200,21 @@ ] (return (&/|list (&/V "Expression" (&/T (&/V "lambda" (&/T =scope =captured ?arg =body)) =lambda-type)))))))) -(defn analyse-def [analyse ?name ?value] +(defn analyse-def [analyse exo-type ?name ?value] ;; (prn 'analyse-def ?name ?value) - (exec [module-name &/get-module-name] + (exec [_ (&type/solve &type/Nothing exo-type) + module-name &/get-module-name] (&/if% (&&def/defined? module-name ?name) (fail (str "[Analyser Error] Can't redefine " ?name)) (exec [=value (&/with-scope ?name - (&&/analyse-1 analyse ?value)) + (&&/with-var + #(&&/analyse-1 analyse % ?value))) =value-type (&&/expr-type =value) + :let [_ (prn 'analyse-def ?name (&type/show-type =value-type))] _ (&&def/define module-name ?name =value-type)] (return (&/|list (&/V "Statement" (&/V "def" (&/T ?name =value))))))))) -(defn analyse-declare-macro [ident] +(defn analyse-declare-macro [exo-type ident] (|let [[?module ?name] ident] (exec [module-name &/get-module-name] (if (= ?module module-name) @@ -211,23 +222,18 @@ (return (&/|list))) (fail "Can't declare macros from foreign modules."))))) -(defn analyse-import [analyse ?path] +(defn analyse-import [analyse exo-type ?path] (assert false) (return (&/|list))) -(defn analyse-check [analyse eval! ?type ?value] +(defn analyse-check [analyse eval! exo-type ?type ?value] (println "analyse-check#0") - (exec [=type (&&/analyse-1 analyse ?type) + (exec [=type (&&/analyse-1 analyse &type/Type ?type) :let [_ (println "analyse-check#1")] - =type-type (&&/expr-type =type) - :let [_ (println "analyse-check#2") - _ (println 1 (&type/show-type &type/Type)) - _ (println 2 (&type/show-type =type-type))] - _ (&type/solve &type/init-fixpoints &type/Type =type-type) - :let [_ (println "analyse-check#3")] ==type (eval! =type) + _ (&type/solve &type/init-fixpoints exo-type ==type) :let [_ (println "analyse-check#4" (&type/show-type ==type))] - =value (&&/analyse-1 analyse ?value) + =value (&&/analyse-1 analyse ==type ?value) :let [_ (println "analyse-check#5")]] (matchv ::M/objects [=value] [["Expression" [?expr ?expr-type]]] @@ -236,7 +242,7 @@ :let [_ (println "analyse-check#7")]] (return (&/|list (&/V "Expression" (&/T ?expr ==type)))))))) -(defn analyse-coerce [analyse eval! ?type ?value] +(defn analyse-coerce [analyse eval! exo-type ?type ?value] (exec [=type (&&/analyse-1 analyse ?type) =type-type (&&/expr-type =type) _ (&type/solve &type/init-fixpoints &type/Type =type-type) diff --git a/src/lux/base.clj b/src/lux/base.clj index 29ecfd123..cd5801660 100644 --- a/src/lux/base.clj +++ b/src/lux/base.clj @@ -312,12 +312,15 @@ (do-template [<name> <joiner>] (defn <name> [f xs] + ;; (prn '<name> 0 (aget xs 0)) (matchv ::M/objects [xs] [["lux;Nil" _]] (return xs) [["lux;Cons" [x xs*]]] (exec [y (f x) + ;; :let [_ (prn '<name> 1 (class y)) + ;; _ (prn '<name> 2 (aget y 0))] ys (<name> f xs*)] (return (<joiner> y ys))))) @@ -658,7 +661,7 @@ (monad state)) (defn show-ast [ast] - ;; (prn 'show-ast (aget ast 0)) + (prn 'show-ast (aget ast 0)) ;; (prn 'show-ast (aget ast 1 1 0)) ;; (cond (= "lux;Meta" (aget ast 1 1 0)) ;; (prn 'EXTRA 'show-ast (aget ast 1 1 1 1 0)) diff --git a/src/lux/lexer.clj b/src/lux/lexer.clj index 918ddc7d9..4dc46f41c 100644 --- a/src/lux/lexer.clj +++ b/src/lux/lexer.clj @@ -80,10 +80,9 @@ (def ^:private lex-ident (&/try-all% (&/|list (exec [[_ [meta _]] (&reader/read-text ";") - [_ [_ token]] (&reader/read-regex +ident-re+) - module-name &/get-module-name] - (return (&/V "lux;Meta" (&/T meta (&/T module-name token))))) - (exec [[_ [metma token]] (&reader/read-regex +ident-re+)] + [_ [_ token]] (&reader/read-regex +ident-re+)] + (return (&/V "lux;Meta" (&/T meta (&/T "lux" token))))) + (exec [[_ [meta token]] (&reader/read-regex +ident-re+)] (&/try-all% (&/|list (exec [_ (&reader/read-text ";") [_ [_ local-token]] (&reader/read-regex +ident-re+)] (&/try-all% (&/|list (exec [unaliased (&def/unalias-module token)] @@ -93,8 +92,7 @@ (return (&/V "lux;Meta" (&/T meta (&/T token local-token)))) (fail (str "[Lexer Error] Unknown module: " token)))) ))) - (exec [module-name &/get-module-name] - (return (&/V "lux;Meta" (&/T meta (&/T module-name token))))) + (return (&/V "lux;Meta" (&/T meta (&/T "" token)))) ))) ))) diff --git a/src/lux/type.clj b/src/lux/type.clj index 7d05d65b4..77025b62e 100644 --- a/src/lux/type.clj +++ b/src/lux/type.clj @@ -67,12 +67,12 @@ [["lux;LambdaT" [?arg ?return]]] (exec [=arg (clean tvar ?arg) =return (clean tvar ?return)] - (return (&/V "lux;LambdaT" (to-array [=arg =return])))) + (return (&/V "lux;LambdaT" (&/T =arg =return)))) [["lux;AppT" [?lambda ?param]]] (exec [=lambda (clean tvar ?lambda) =param (clean tvar ?param)] - (return (&/V "lux;AppT" (to-array [=lambda =param])))) + (return (&/V "lux;AppT" (&/T =lambda =param)))) [["lux;TupleT" ?members]] (exec [=members (&/map% (partial clean tvar) ?members)] @@ -81,23 +81,23 @@ [["lux;VariantT" ?members]] (exec [=members (&/map% (fn [[k v]] (exec [=v (clean tvar v)] - (return (to-array [k =v])))) + (return (&/T k =v)))) ?members)] (return (&/V "lux;VariantT" =members))) [["lux;RecordT" ?members]] (exec [=members (&/map% (fn [[k v]] (exec [=v (clean tvar v)] - (return (to-array [k =v])))) + (return (&/T k =v)))) ?members)] (return (&/V "lux;RecordT" =members))) [["lux;AllT" [?env ?name ?arg ?body]]] (exec [=env (&/map% (fn [[k v]] (exec [=v (clean tvar v)] - (return (to-array [k =v])))) + (return (&/T k =v)))) ?env)] - (return (&/V "lux;AllT" (to-array [=env ?name ?arg ?body])))) + (return (&/V "lux;AllT" (&/T =env ?name ?arg ?body)))) [_] (return type) @@ -113,7 +113,9 @@ "Nothing" [["lux;DataT" [name params]]] - (str "(^ " name " [" (->> params (&/|map show-type) (&/|interpose " ") (&/fold str "")) "])") + (if (&/|empty? params) + "(,)" + (str "(^ " name " [" (->> params (&/|map show-type) (&/|interpose " ") (&/fold str "")) "])")) [["lux;TupleT" elems]] (str "(, " (->> elems (&/|map show-type) (&/|interpose " ") (&/fold str "")) ")") @@ -217,8 +219,8 @@ (type= xbody ybody)) [_ _] - (do (prn 'type= (show-type x) (show-type y)) - false) + (do ;; (prn 'type= (show-type x) (show-type y)) + false) )) (defn ^:private fp-get [k xs] @@ -275,7 +277,7 @@ (if-let [bound (&/|get ?name env)] (do ;; (prn 'beta-reduce "lux;BoundT" ?name (->> (&/|keys env) (&/|interpose " ") (&/fold str "")) ;; (show-type bound)) - (beta-reduce env bound)) + (beta-reduce env bound)) type) [_] @@ -294,7 +296,7 @@ (def +dont-care+ (&/V "lux;AnyT" nil)) (defn apply-type [type-fn param] - (prn 'apply-type (aget type-fn 0) (aget param 0)) + ;; (prn 'apply-type (aget type-fn 0) (aget param 0)) (matchv ::M/objects [type-fn] [["lux;AllT" [local-env local-name local-arg local-def]]] (return (beta-reduce (->> local-env @@ -311,24 +313,24 @@ (def init-fixpoints (&/|list)) -(defn solve [fixpoints expected actual] - (prn 'solve (aget expected 0) (aget actual 0)) - ;; (prn 'solve (show-type expected) (show-type actual)) +(defn ^:private solve* [fixpoints expected actual] + (prn 'solve* (aget expected 0) (aget actual 0)) + ;; (prn 'solve* (show-type expected) (show-type actual)) (matchv ::M/objects [expected actual] - [["Any" _] _] + [["lux;AnyT" _] _] success - [_ ["Nothing" _]] + [_ ["lux;NothingT" _]] success [["lux;VarT" ?id] _] (&/try-all% (&/|list (exec [bound (deref ?id)] - (solve fixpoints bound actual)) + (solve* fixpoints bound actual)) (reset ?id actual))) [_ ["lux;VarT" ?id]] (&/try-all% (&/|list (exec [bound (deref ?id)] - (solve fixpoints expected bound)) + (solve* fixpoints expected bound)) (reset ?id expected))) [["lux;AppT" [F A]] _] @@ -341,21 +343,21 @@ (fail (solve-error expected actual))) [["lux;None" _]] - (solve (fp-put fp-pair true fixpoints) expected* actual))) + (solve* (fp-put fp-pair true fixpoints) expected* actual))) [_ ["lux;AppT" [F A]]] (exec [actual* (apply-type F A)] - (solve fixpoints expected actual*)) + (solve* fixpoints expected actual*)) [["lux;AllT" _] _] (exec [$var fresh-var expected* (apply-type expected $var)] - (solve fixpoints expected* actual)) + (solve* fixpoints expected* actual)) [_ ["lux;AllT" _]] (exec [$var fresh-var actual* (apply-type actual $var)] - (solve fixpoints expected actual*)) + (solve* fixpoints expected actual*)) [["lux;DataT" [e!name e!params]] ["lux;DataT" [a!name a!params]]] (cond (not= e!name a!name) @@ -367,22 +369,23 @@ :else (exec [_ (&/map% (fn [ea] (|let [[e a] ea] - (solve fixpoints e a))) + (solve* fixpoints e a))) (&/zip2 e!params a!params))] success)) [["lux;LambdaT" [eI eO]] ["lux;LambdaT" [aI aO]]] - (exec [_ (solve fixpoints aI eI)] - (solve fixpoints eO aO)) + (exec [_ (solve* fixpoints aI eI)] + (solve* fixpoints eO aO)) [["lux;TupleT" e!members] ["lux;TupleT" a!members]] (if (= (&/|length e!members) (&/|length a!members)) (exec [_ (&/map% (fn [ea] (|let [[e a] ea] - (do (prn "lux;TupleT" 'ITER (show-type e) (show-type a)) - (solve fixpoints e a)))) + (do ;; (prn "lux;TupleT" 'ITER (show-type e) (show-type a)) + (solve* fixpoints e a)))) (&/zip2 e!members a!members)) - :let [_ (prn "lux;TupleT" 'DONE)]] + ;; :let [_ (prn "lux;TupleT" 'DONE)] + ] success) (do ;; (prn "lux;TupleT" (&/|length e!members) (&/|length a!members)) ;; (prn "lux;TupleT" @@ -395,7 +398,7 @@ (exec [_ (&/map% (fn [kv] (|let [[k av] kv] (if-let [ev (&/|get k e!cases)] - (solve fixpoints ev av) + (solve* fixpoints ev av) (fail (str "[Type Error] The expected variant cannot handle case: #" k))))) a!cases)] success) @@ -405,33 +408,41 @@ (exec [_ (&/map% (fn [slot] (if-let [e!type (&/|get e!fields slot)] (if-let [a!type (&/|get a!fields slot)] - (solve fixpoints e!type a!type) + (solve* fixpoints e!type a!type) (fail (solve-error expected actual))) (fail (solve-error expected actual)))) (&/|keys e!fields))] success) (fail "[Type Error] Records don't match in size.")) - [["lux;BoundT" name] _] - (do (prn "lux;BoundT" name) - (assert false)) + ;; [["lux;BoundT" name] _] + ;; (do (prn "lux;BoundT" name) + ;; (assert false)) ;; ... ;; [_ ["lux;BoundT" name]] ;; ... )) +(def solve (partial solve* init-fixpoints)) + (defn apply-lambda [func param] (matchv ::M/objects [func] [["lux;LambdaT" [input output]]] - (exec [_ (solve init-fixpoints input param)] + (exec [_ (solve* init-fixpoints input param)] (return output)) + [["lux;AllT" [local-env local-name local-arg local-def]]] + (exec [$var fresh-var + func* (apply-type func $var)] + (apply-lambda func* param)) + [_] (fail (str "[Type System] Can't apply type " (show-type func) " to type " (show-type param))) )) (def Any (&/V "lux;AnyT" nil)) +(def Nothing (&/V "lux;NothingT" nil)) (def Int (&/V "lux;DataT" (&/T "java.lang.Long" (&/|list)))) (def Text (&/V "lux;DataT" (&/T "java.lang.String" (&/|list)))) @@ -483,7 +494,7 @@ (matchv ::M/objects [kv] [[k v]] (if-let [cv (&/|get k cases)] - (exec [_ (solve init-fixpoints cv v)] + (exec [_ (solve* init-fixpoints cv v)] (return cases)) (return (&/|put k v cases))))) x!cases @@ -496,7 +507,7 @@ (matchv ::M/objects [kv] [[k v]] (if-let [cv (&/|get k fields)] - (exec [_ (solve init-fixpoints cv v)] + (exec [_ (solve* init-fixpoints cv v)] (return fields)) (fail (str "[Type System Error] Incompatible records: " (show-type x) " and " (show-type y)))))) x!fields @@ -513,7 +524,7 @@ (&/V "lux;VariantT" (&/|list (&/T "lux;Nil" (&/V "lux;TupleT" (&/|list))))))))))) ) - (matchv ::M/objects [((solve init-fixpoints Type RealT) + (matchv ::M/objects [((solve Type RealT) (&/init-state nil))] [["lux;Left" ?msg]] (assert false ?msg) @@ -521,7 +532,7 @@ [_] (println "YEAH!")) - (matchv ::M/objects [((solve init-fixpoints List (&/V "lux;AppT" (&/T List Real))) + (matchv ::M/objects [((solve List (&/V "lux;AppT" (&/T List Real))) (&/init-state nil))] [["lux;Left" ?msg]] (assert false ?msg) |