From 3cbe80d419ad328badc75732984297eaac116f5f Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 23 Apr 2015 00:24:16 -0400 Subject: - Removed analyse-2, as it was redundant. - Fixed several bugs within lux.lux. - Renamed "check'" to ":'" and "coerce" to ":!". --- source/lux.lux | 856 +++++++++++++++++++++----------------------- src/lux/analyser.clj | 6 +- src/lux/analyser/base.clj | 12 - src/lux/analyser/case.clj | 4 +- src/lux/analyser/host.clj | 11 +- src/lux/analyser/lambda.clj | 10 +- src/lux/analyser/lux.clj | 42 ++- src/lux/compiler/case.clj | 2 +- src/lux/compiler/lambda.clj | 62 +++- 9 files changed, 499 insertions(+), 506 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 [ ] -## ## ## ## (def ( p xs) -## ## ## ## (case xs -## ## ## ## #Nil true -## ## ## ## (#Cons [x xs']) ( (p x) ( p xs')))) +## ## (do-template [ ] +## ## (def ( p xs) +## ## (case xs +## ## #Nil true +## ## (#Cons [x xs']) ( (p x) ( p xs')))) -## ## ## ## [every? and] -## ## ## ## [any? or]) +## ## [every? and] +## ## [any? or]) ## (def (range from to) ## (-> Int Int (List Int)) @@ -1022,11 +995,11 @@ ## (map (. apply (zip2 bindings-list))) ## return)))) -## ## ## ## (do-template [ ] -## ## ## ## (def (int+ )) +## ## (do-template [ ] +## ## (def (int+ )) -## ## ## ## [inc 1] -## ## ## ## [dec -1]) +## ## [inc 1] +## ## [dec -1]) ## (def (int= x y) ## (-> 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))))))))) diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index 181d76b5b..9097168e2 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -101,13 +101,13 @@ ["lux;Nil" _]]]]]]]]] (&&lux/analyse-import analyse ?path) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "check'"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ":"]]]] ["lux;Cons" [?type ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]]]] (&&lux/analyse-check analyse eval! exo-type ?type ?value) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "coerce'"]]]] + [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ":!"]]]] ["lux;Cons" [?type ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]]]] @@ -435,7 +435,7 @@ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [?fn ?args]]]]]] (fn [state] - ;; (prn '(&/show-ast ?fn) (&/show-ast ?fn)) + ;; (prn 'analyse-ast '(&/show-ast ?fn) (&/show-ast ?fn)) (matchv ::M/objects [((&type/with-var #(&&/analyse-1 (partial analyse-ast eval!) % ?fn)) state)] [["lux;Right" [state* =fn]]] ((&&lux/analyse-apply (partial analyse-ast eval!) exo-type =fn ?args) state*) diff --git a/src/lux/analyser/base.clj b/src/lux/analyser/base.clj index 4b23f9460..1653a4fa1 100644 --- a/src/lux/analyser/base.clj +++ b/src/lux/analyser/base.clj @@ -26,18 +26,6 @@ [_] (fail "[Analyser Error] Can't expand to other than 1 element."))))) -(defn analyse-2 [analyse exo-type1 el1 exo-type2 el2] - (|do [output1 (analyse exo-type1 el1) - output2 (analyse exo-type2 el2)] - (do ;; (prn 'analyse-2 (aget output 0)) - (matchv ::M/objects [output1 output2] - [["lux;Cons" [x ["lux;Nil" _]]] - ["lux;Cons" [y ["lux;Nil" _]]]] - (return (&/T x y)) - - [_ _] - (fail "[Analyser Error] Can't expand to other than 2 elements."))))) - (defn resolved-ident [ident] (|let [[?module ?name] ident] (|do [module* (if (= "" ?module) diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj index a9424b50d..e1f5c4c84 100644 --- a/src/lux/analyser/case.clj +++ b/src/lux/analyser/case.clj @@ -203,7 +203,7 @@ )))) (defn ^:private check-totality [value-type struct] - (prn 'check-totality (aget value-type 0) (aget struct 0) (&type/show-type value-type)) + ;; (prn 'check-totality (aget value-type 0) (aget struct 0) (&type/show-type value-type)) (matchv ::M/objects [struct] [["BoolTotal" [?total _]]] (return ?total) @@ -279,7 +279,7 @@ (analyse-branch analyse exo-type value-type pattern body patterns))) (&/|list) branches) - :let [_ (prn 'PRE_MERGE_TOTALS)] + ;; :let [_ (prn 'PRE_MERGE_TOTALS)] struct (&/fold% merge-total (&/V "DefaultTotal" false) patterns) ? (check-totality value-type struct)] (if ? diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj index b282f806e..299471ee8 100644 --- a/src/lux/analyser/host.clj +++ b/src/lux/analyser/host.clj @@ -23,7 +23,8 @@ (let [input-type (&/V "lux;DataT" ) output-type (&/V "lux;DataT" )] (defn [analyse ?x ?y] - (|do [[=x =y] (&&/analyse-2 analyse input-type ?x input-type ?y)] + (|do [=x (&&/analyse-1 analyse input-type ?x) + =y (&&/analyse-1 analyse input-type ?y)] (return (&/|list (&/V "Expression" (&/T (&/V (&/T =x =y)) output-type))))))) analyse-jvm-iadd "jvm-iadd" "java.lang.Integer" "java.lang.Integer" @@ -136,11 +137,9 @@ (&/V "lux;Nil" nil))))))))) (defn analyse-jvm-aastore [analyse ?array ?idx ?elem] - (|do [=array+=elem (&&/analyse-2 analyse ?array ?elem) - :let [[=array =elem] (matchv ::M/objects [=array+=elem] - [[=array =elem]] - [=array =elem])] - =array-type (&&/expr-type =array)] + (|do [=array (&&/analyse-1 analyse &type/Nothing ?array) + =elem (&&/analyse-1 analyse &type/Nothing ?elem) + =array-type (&&/expr-type =array)] (return (&/|list (&/V "Expression" (&/T (&/V "jvm-aastore" (&/T =array ?idx =elem)) =array-type)))))) (defn analyse-jvm-aaload [analyse ?array ?idx] diff --git a/src/lux/analyser/lambda.clj b/src/lux/analyser/lambda.clj index 553c4ea9b..da9d6b044 100644 --- a/src/lux/analyser/lambda.clj +++ b/src/lux/analyser/lambda.clj @@ -21,11 +21,11 @@ (return (&/T scope-name =captured =return))))))))) (defn close-over [scope ident register frame] - (prn 'close-over - (&host/location scope) - (&host/location (&/|list ident)) - register - (->> frame (&/get$ "lux;closure") (&/get$ "lux;counter"))) + ;; (prn 'close-over + ;; (&host/location scope) + ;; (&host/location (&/|list ident)) + ;; register + ;; (->> frame (&/get$ "lux;closure") (&/get$ "lux;counter"))) (matchv ::M/objects [register] [["Expression" [_ register-type]]] (|let [register* (&/V "Expression" (&/T (&/V "captured" (&/T scope diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index f1c7a6035..68d612db6 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -16,7 +16,7 @@ (defn ^:private analyse-1+ [analyse ?token] (&type/with-var (fn [$var] - (prn 'analyse-1+ (aget $var 1) (&/show-ast ?token)) + ;; (prn 'analyse-1+ (aget $var 1) (&/show-ast ?token)) (|do [=expr (&&/analyse-1 analyse $var ?token)] (matchv ::M/objects [=expr] [["Expression" [?item ?type]]] @@ -125,7 +125,7 @@ ;; _ (&type/check exo-type btype)] ;; (return (&/|list global))) state) - (do (prn (str "((" (->> stack (&/|map show-frame) &/->seq (interpose " ") (reduce str "")) "))")) + (do ;; (prn (str "((" (->> stack (&/|map show-frame) &/->seq (interpose " ") (reduce str "")) "))")) (fail* (str "[Analyser Error] Unrecognized identifier: " local-ident)))) [["lux;Cons" [top-outer _]]] @@ -150,7 +150,8 @@ )) (defn ^:private analyse-apply* [analyse exo-type =fn ?args] - (prn 'analyse-apply*/exo-type (&type/show-type exo-type)) + ;; (prn 'analyse-apply* (&/->seq (&/|map &/show-ast ?args))) + ;; (prn 'analyse-apply*/exo-type (&type/show-type exo-type)) (matchv ::M/objects [=fn] [["Statement" _]] (fail "[Analyser Error] Can't apply a statement!") @@ -162,7 +163,7 @@ (return (&/|list =fn))) [["lux;Cons" [?arg ?args*]]] - (do (prn 'analyse-apply*/=fn (&type/show-type ?fun-type)) + (do ;; (prn 'analyse-apply*/=fn (&type/show-type ?fun-type)) (matchv ::M/objects [?fun-type] [["lux;AllT" _]] (&type/with-var @@ -175,13 +176,16 @@ (return (&/|list (&/V "Expression" (&/T ?expr* type**))))) [_] - (do (prn 'analyse-apply*/output (aget output 0)) - (assert false)))))) + (assert false (prn-str 'analyse-apply*/output (aget output 0))))))) [["lux;LambdaT" [?input-t ?output-t]]] + ;; (|do [=arg (&&/analyse-1 analyse ?input-t ?arg)] + ;; (return (&/|list (&/V "Expression" (&/T (&/V "apply" (&/T =fn =arg)) + ;; ?output-t))))) (|do [=arg (&&/analyse-1 analyse ?input-t ?arg)] - (return (&/|list (&/V "Expression" (&/T (&/V "apply" (&/T =fn =arg)) - ?output-t))))) + (analyse-apply* analyse exo-type (&/V "Expression" (&/T (&/V "apply" (&/T =fn =arg)) + ?output-t)) + ?args*)) [_] (fail "[Analyser Error] Can't apply a non-function."))) @@ -199,7 +203,10 @@ (if macro? (let [macro-class (&host/location (&/|list ?module ?name))] (|do [macro-expansion (¯o/expand loader macro-class ?args) - :let [_ (prn 'EXPANDING (&type/show-type exo-type))] + ;; :let [_ (when (and (= "lux" ?module) + ;; (= "`" ?name)) + ;; (prn 'macro-expansion (->> macro-expansion (&/|map &/show-ast) (&/|interpose " ") (&/fold str ""))))] + ;; :let [_ (prn 'EXPANDING (&type/show-type exo-type))] output (&/flat-map% (partial analyse exo-type) macro-expansion)] (return output))) (analyse-apply* analyse exo-type =fn ?args))) @@ -212,15 +219,16 @@ )) (defn analyse-case [analyse exo-type ?value ?branches] - (prn 'analyse-case 'exo-type (&type/show-type exo-type) (&/show-ast ?value)) + ;; (prn 'analyse-case 'exo-type (&type/show-type exo-type) (&/show-ast ?value)) (|do [:let [num-branches (&/|length ?branches)] _ (&/assert! (> num-branches 0) "[Analyser Error] Can't have empty branches in \"case'\" expression.") _ (&/assert! (even? num-branches) "[Analyser Error] Unbalanced branches in \"case'\" expression.") =value (analyse-1+ analyse ?value) =value-type (&&/expr-type =value) - :let [_ (prn 'analyse-case/GOT_VALUE (&type/show-type =value-type))] + ;; :let [_ (prn 'analyse-case/GOT_VALUE (&type/show-type =value-type))] =match (&&case/analyse-branches analyse exo-type =value-type (&/|as-pairs ?branches)) - :let [_ (prn 'analyse-case/GOT_MATCH)]] + ;; :let [_ (prn 'analyse-case/GOT_MATCH)] + ] (return (&/|list (&/V "Expression" (&/T (&/V "case" (&/T =value =match)) exo-type)))))) @@ -237,7 +245,7 @@ (fail (str "[Analyser Error] Functions require function types: " (&type/show-type exo-type))))) (defn analyse-lambda** [analyse exo-type ?self ?arg ?body] - (prn 'analyse-lambda**/&& (aget exo-type 0)) + ;; (prn 'analyse-lambda**/&& (aget exo-type 0)) (matchv ::M/objects [exo-type] [["lux;AllT" _]] (&type/with-var @@ -270,7 +278,8 @@ ;; :let [_ (prn 'analyse-def/_1)] =value-type (&&/expr-type =value) ;; :let [_ (prn 'analyse-def/_2)] - :let [_ (prn 'analyse-def/TYPE ?name (&type/show-type =value-type))] + :let [_ (prn 'analyse-def/TYPE ?name (&type/show-type =value-type)) + _ (println)] _ (&&def/define module-name ?name =value-type) ;; :let [_ (prn 'analyse-def/_3)] ] @@ -278,9 +287,10 @@ (defn analyse-declare-macro [ident] (|do [current-module &/get-module-name - :let [_ (prn 'analyse-declare-macro/current-module current-module)] + ;; :let [_ (prn 'analyse-declare-macro/current-module current-module)] [?module ?name] (&&/resolved-ident* ident) - :let [_ (prn 'analyse-declare-macro '[?module ?name] [?module ?name])]] + ;; :let [_ (prn 'analyse-declare-macro '[?module ?name] [?module ?name])] + ] (if (= ?module current-module) (|do [_ (&&def/declare-macro ?module ?name)] (return (&/|list))) diff --git a/src/lux/compiler/case.clj b/src/lux/compiler/case.clj index 8f737af20..d6a259476 100644 --- a/src/lux/compiler/case.clj +++ b/src/lux/compiler/case.clj @@ -142,7 +142,7 @@ (doseq [?body+?match (&/->seq patterns) :let [;; _ (prn 'compile-pattern-matching/pattern pattern) ;; _ (prn '?body+?match (alength ?body+?match) (aget ?body+?match 0)) - _ (prn '?body+?match (aget ?body+?match 0)) + ;; _ (prn '?body+?match (aget ?body+?match 0)) $else (new Label)]]))) (.visitInsn Opcodes/POP) (.visitTypeInsn Opcodes/NEW ex-class) diff --git a/src/lux/compiler/lambda.clj b/src/lux/compiler/lambda.clj index 332f9804b..3c3774e7e 100644 --- a/src/lux/compiler/lambda.clj +++ b/src/lux/compiler/lambda.clj @@ -40,7 +40,8 @@ (.visitVarInsn Opcodes/ALOAD (inc ?captured-id)) (.visitFieldInsn Opcodes/PUTFIELD class-name captured-name clo-field-sig)) (->> (let [captured-name (str &&/closure-prefix ?captured-id) - _ (prn 'add-lambda- class-name ?captured-id)]) + ;; _ (prn 'add-lambda- class-name ?captured-id) + ]) (matchv ::M/objects [?name+?captured] [[?name ["Expression" [["captured" [_ ?captured-id ?source]] _]]]]) (doseq [?name+?captured (&/->seq env)]))) @@ -78,23 +79,50 @@ (return ret)))) (defn ^:private instance-closure [compile lambda-class closed-over init-signature] - ;; (prn 'instance-closure lambda-class closed-over init-signature) + ;; (prn 'instance-closure lambda-class (&/|length closed-over) init-signature) (|do [*writer* &/get-writer - :let [_ (doto *writer* - (.visitTypeInsn Opcodes/NEW lambda-class) - (.visitInsn Opcodes/DUP))] - _ (->> closed-over - &/->seq - (sort #(matchv ::M/objects [(&/|second %1) (&/|second %2)] - [["Expression" [["captured" [_ ?cid1 _]] _]] - ["Expression" [["captured" [_ ?cid2 _]] _]]] - (< ?cid1 ?cid2))) - &/->list - (&/map% (fn [?name+?captured] - (matchv ::M/objects [?name+?captured] - [[?name ["Expression" [["captured" [_ _ ?source]] _]]]] - (compile ?source))))) - :let [_ (.visitMethodInsn *writer* Opcodes/INVOKESPECIAL lambda-class "" init-signature)]] + :let [_ (doto *writer* + (.visitTypeInsn Opcodes/NEW lambda-class) + (.visitInsn Opcodes/DUP)) + ;; _ (prn 'closed-over/pre + ;; (&/->seq (&/|map #(matchv ::M/objects [(&/|second %1)] + ;; [["Expression" [["captured" [_ ?cid _]] _]]] + ;; ?cid) + ;; closed-over))) + ;; _ (prn 'closed-over/post + ;; (->> closed-over + ;; &/->seq + ;; (sort #(matchv ::M/objects [(&/|second %1) (&/|second %2)] + ;; [["Expression" [["captured" [_ ?cid1 _]] _]] + ;; ["Expression" [["captured" [_ ?cid2 _]] _]]] + ;; (< ?cid1 ?cid2))) + ;; &/->list + ;; (&/|map #(matchv ::M/objects [(&/|second %1)] + ;; [["Expression" [["captured" [_ ?cid _]] _]]] + ;; ?cid)) + ;; &/->seq)) + ] + _ (->> closed-over + &/->seq + (sort #(matchv ::M/objects [(&/|second %1) (&/|second %2)] + [["Expression" [["captured" [_ ?cid1 _]] _]] + ["Expression" [["captured" [_ ?cid2 _]] _]]] + (< ?cid1 ?cid2))) + &/->list + (&/map% (fn [?name+?captured] + (matchv ::M/objects [?name+?captured] + [[?name ["Expression" [["captured" [_ _ ?source]] _]]]] + (do ;; (prn '?source (aget ?source 1 0 0) + ;; (cond (= "captured" (aget ?source 1 0 0)) + ;; ["captured" (aget ?source 1 0 1 1)] + + ;; (= "local" (aget ?source 1 0 0)) + ;; ["local" (aget ?source 1 0 1)] + + ;; :else + ;; '???)) + (compile ?source)))))) + :let [_ (.visitMethodInsn *writer* Opcodes/INVOKESPECIAL lambda-class "" init-signature)]] (return nil))) ;; [Exports] -- cgit v1.2.3