diff options
Diffstat (limited to 'source/lux.lux')
| -rw-r--r-- | source/lux.lux | 856 |
1 files changed, 412 insertions, 444 deletions
diff --git a/source/lux.lux b/source/lux.lux index b03de7473..dee780e98 100644 --- a/source/lux.lux +++ b/source/lux.lux @@ -79,25 +79,25 @@ ## (| #None ## (#Some a))) (def' Maybe - (check' Type - (#AllT [#Nil "Maybe" "a" - (#VariantT (#Cons [["lux;None" (#TupleT #Nil)] - (#Cons [["lux;Some" (#BoundT "a")] - #Nil])]))]))) + (: Type + (#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 - (check' Type - (#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])]))])]))) + (: Type + (#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 @@ -105,41 +105,41 @@ ## #locals (Bindings k v) ## #closure (Bindings k v))) (def' Env - (check' Type - (#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])])])]))])]))) + (: Type + (#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 - (check' Type - (#TupleT (#Cons [Text (#Cons [Int (#Cons [Int #Nil])])])))) + (: Type + (#TupleT (#Cons [Text (#Cons [Int (#Cons [Int #Nil])])])))) ## (deftype (Meta m v) ## (| (#Meta (, m v)))) (def' Meta - (check' Type - (#AllT [#Nil "Meta" "m" - (#AllT [#Nil "" "v" - (#VariantT (#Cons [["lux;Meta" (#TupleT (#Cons [(#BoundT "m") - (#Cons [(#BoundT "v") - #Nil])]))] - #Nil]))])]))) + (: Type + (#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 - (check' Type - (#AppT [List - (#AppT [(#AppT [Meta Cursor]) - Text])]))) + (: Type + (#AppT [List + (#AppT [(#AppT [Meta Cursor]) + Text])]))) ## (deftype CompilerState ## (& #source (Maybe Reader) @@ -152,36 +152,18 @@ ## #loader (^ java.net.URLClassLoader) ## #eval-ctor Int)) (def' CompilerState - (check' Type - (#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")] - (#Cons [["lux;loader" (#DataT "java.lang.ClassLoader")] - (#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) -## (#Real Real) -## (#Char Char) -## (#Text Text) -## (#Form (List Syntax)) -## (#Tuple (List Syntax)) -## (#Record (List (, Text Syntax)))))) + (: Type + (#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")] + (#Cons [["lux;loader" (#DataT "java.lang.ClassLoader")] + (#Cons [["lux;eval-ctor" Int] + #Nil])])])])])])])])])))) + ## (deftype (Syntax' w) ## (| (#Bool Bool) ## (#Int Int) @@ -194,246 +176,217 @@ ## (#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]) - ])])])])])])])])]) - )]) - ))))) + (: 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 [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]))))) + (: Type + (case' (#AppT [Meta Cursor]) + w + (#AppT [w (#AppT [Syntax' w])])))) ## (deftype (Either l r) ## (| (#Left l) ## (#Right r))) (def' Either - (check' Type - (#AllT [#Nil "_" "l" - (#AllT [#Nil "" "r" - (#VariantT (#Cons [["lux;Left" (#BoundT "l")] - (#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])]))])))) + (: Type + (#AllT [#Nil "_" "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 - (check' Type - (case' (#AppT [List Syntax]) - SyntaxList - (#LambdaT [SyntaxList - (#LambdaT [CompilerState - (#AppT [(#AppT [Either Text]) - (#TupleT (#Cons [CompilerState - (#Cons [SyntaxList - #Nil])]))])])])))) + (: Type + (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) ## (-> (Syntax' (Meta Cursor)) Syntax) ## (#Meta [["" -1 -1] data])) (def' _meta - (check' (#LambdaT [(#AppT [Syntax' - (#AppT [Meta Cursor])]) - Syntax]) - (lambda' _ data - (#Meta [["" -1 -1] data])))) + (: (#LambdaT [(#AppT [Syntax' + (#AppT [Meta Cursor])]) + Syntax]) + (lambda' _ data + (#Meta [["" -1 -1] data])))) ## (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]))))) + (: (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))))) + (: (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 +## (: 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])) - + ## _ ## (#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'"))))) + (: 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"))))) + (: 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") - )))) + (: 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 ["" ":"])) + (#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 ["" ":"])) + (#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) @@ -552,19 +505,19 @@ (def (reverse' list) (->' ($' List Syntax) ($' List Syntax)) - (fold' (check' (->' ($' List Syntax) Syntax - ($' List Syntax)) - (lambda [tail head] - (#Cons [head tail]))) + (fold' (: (->' ($' 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])]))))) + (return' (#Cons [(fold' (: (->' 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]))) @@ -572,36 +525,130 @@ (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)))))))) + (return' (list (fold' (: (->' 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')]) +(def (as-pairs' xs) + (All' [a] + (->' ($' List (B' a)) ($' List (#TupleT (list (B' a) (B' a)))))) + (case' xs + (#Cons [x (#Cons [y xs'])]) + (list& [x y] (as-pairs' xs')) -## _ -## #Nil)) + _ + #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)])))) +(defmacro (let tokens) + (case' tokens + (#Cons [(#Meta [_ (#Tuple bindings)]) (#Cons [body #Nil])]) + (return' (list (fold' (: (->' Syntax (#TupleT (list Syntax Syntax)) + Syntax) + (lambda [body binding] + (case' binding + [label value] + (_meta (#Form (list (_meta (#Symbol ["lux" "let'"])) label value body)))))) + body + (fold' (: (->' ($' List (#TupleT (list Syntax Syntax))) (#TupleT (list Syntax Syntax)) + ($' List (#TupleT (list Syntax Syntax)))) + (lambda [tail head] + (#Cons [head tail]))) + #Nil + (as-pairs' bindings))))) + + _ + (fail' "Wrong syntax for let"))) + +(def (map' f xs) + (All' [a b] + (->' (->' (B' a) (B' b)) ($' List (B' a)) ($' List (B' b)))) + (case' xs + #Nil + #Nil + + (#Cons [x xs']) + (#Cons [(f x) (map' f xs')]))) + +(def (wrap-meta content) + (->' ($' Syntax' ($' Meta Cursor)) Syntax) + (_meta (#Form (list (_meta (#Tag ["lux" "Meta"])) + (_meta (#Tuple (list (_meta (#Tuple (list (_meta (#Text "")) (_meta (#Int -1)) (_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) + (->' Syntax Syntax) + (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))))) + + (#Meta [_ (#Record fields)]) + (wrap-meta (#Record (map' (: (->' (#TupleT (list Text Syntax)) (#TupleT (list Text Syntax))) + (lambda [kv] + (let [[k v] kv] + [k (untemplate v)]))) + fields))) + )) + +(defmacro (` tokens) + (case' tokens + (#Cons [template #Nil]) + (return' (list (untemplate template))) + + _ + (fail' "Wrong syntax for `"))) + +(defmacro (if tokens) + (case' tokens + (#Cons [test (#Cons [then (#Cons [else #Nil])])]) + (return' (list (` (case' (~ test) + true (~ then) + false (~ else))))) + + _ + (fail' "Wrong syntax for if"))) ## (def (print x) ## (-> (^ java.lang.Object) []) @@ -641,85 +688,11 @@ ## (-> (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))) @@ -927,14 +900,14 @@ ## #Nil true ## _ false)) -## ## ## ## (do-template [<name> <op>] -## ## ## ## (def (<name> p xs) -## ## ## ## (case xs -## ## ## ## #Nil true -## ## ## ## (#Cons [x xs']) (<op> (p x) (<name> p xs')))) +## ## (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]) +## ## [every? and] +## ## [any? or]) ## (def (range from to) ## (-> Int Int (List Int)) @@ -1022,11 +995,11 @@ ## (map (. apply (zip2 bindings-list))) ## return)))) -## ## ## ## (do-template [<name> <offset>] -## ## ## ## (def <name> (int+ <offset>)) +## ## (do-template [<name> <offset>] +## ## (def <name> (int+ <offset>)) -## ## ## ## [inc 1] -## ## ## ## [dec -1]) +## ## [inc 1] +## ## [dec -1]) ## (def (int= x y) ## (-> Int Int Bool) @@ -1222,8 +1195,6 @@ ## ## (return (flat-map (lambda [pattern] (list pattern body)) ## ## patterns)))) -## ## (def null jvm-null) - ## (defmacro (^ tokens) ## (case' tokens ## (#Cons [(#Meta [_ (#Symbol [_ class-name])]) #Nil]) @@ -1312,60 +1283,12 @@ ## (~ (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)))) +## ((:! macro Macro) args)))) ## (defmacro (case tokens) ## (case' tokens @@ -1434,8 +1357,10 @@ ## (: (~ def-body) (~ signature)))))))) ## (defsig (Monad m) -## (: return (All [a] (-> a (m a)))) -## (: bind (All [a b] (-> (-> a (m b)) (m a) (m b))))) +## (: (All [a] (-> a (m a))) +## return) +## (: (All [a b] (-> (-> a (m b)) (m a) (m b))) +## bind)) ## (defstruct ListMonad (Monad List) ## (def (return x) @@ -1456,20 +1381,63 @@ ## (= 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]) +## ## (def (with tokens) +## ## ...) + +## ## (import "lux") +## ## (module-alias "lux" "l") +## ## (def-alias "lux;map" "map") + +## ## (def (require tokens) +## ## (case tokens +## ## ...)) + +## ## (require lux #as l #refer [map]) + +## (defsyntax #export (All [name (%? %name)] [args %args] body) +## (let [name' (case name +## #None "" +## (#Some name) name) +## arg-replacements (map (lambda [arg] +## [(#Symbol ["" arg]) (` (#Bound (~ arg)))]) +## args) +## args' (map (lambda [arg] +## (#Symbol ["" arg])) +## args) +## body' (replace-syntax arg-replacements body)] +## (return (list (` (#AllT [#Nil (~ name') (#Tuple (list (~@ args'))) +## (~ body')])))))) + +## (def (walk-syntax type) +## (case type +## (#Meta [_ (#Form (\list& op args))]) +## (case op +## (#Meta [_ (#Symbol ident)]) +## (do' [macro?? (find-macro ident)] +## (case macro?? +## (#Some macro) +## (do' [expansion (macro args)] +## (flat-map% walk-syntax expansion)) + +## #None +## (do' [flat-map% (map% walk-syntax args)] +## (return' (list (fold (lambda [fun arg] +## (` (#AppT [(~ fun) (~ arg)]))) +## op +## args)))))) + +## _ +## (do' [flat-map% (map% walk-syntax args)] +## (return' (list (_meta (#Form (list op args'))))))) + +## _ +## (return' (list type)))) + +## (defsyntax #export (type type-syntax) +## (walk-syntax type-syntax)) + +## (defsyntax #export (deftype [[name args] %usage] body) +## (return (list (` (def (~ name) +## (: Type +## (type (All [(~@ args)] +## (~ body))))))))) |