From 411543f0c331bdfa23dc11988a326ba4a9c44a20 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 26 Apr 2015 01:35:53 -0400 Subject: - Macros are no longer declared. Instead, they are automatically detected. --- source/lux.lux | 527 ++++++++++++++++++++++++----------------------- src/lux/analyser.clj | 5 - src/lux/analyser/lux.clj | 14 +- src/lux/type.clj | 92 +++++++++ 4 files changed, 365 insertions(+), 273 deletions(-) diff --git a/source/lux.lux b/source/lux.lux index f46a9f66d..19a89c8ee 100644 --- a/source/lux.lux +++ b/source/lux.lux @@ -55,11 +55,11 @@ ## (#AllT (, (Maybe (List (, Text Type))) Text Text Type)) ## (#AppT (, Type Type)))) (def' Type - (case' (#AppT [(#BoundT "Type") (#BoundT "")]) + (case' (#AppT [(#BoundT "Type") (#BoundT "_")]) Type (case' (#AppT [List (#TupleT (#Cons [Text (#Cons [Type #Nil])]))]) TypeEnv - (#AppT [(#AllT [#None "Type" "" + (#AppT [(#AllT [#None "Type" "_" (#VariantT (#Cons [["lux;DataT" Text] (#Cons [["lux;TupleT" (#AppT [List Type])] (#Cons [["lux;VariantT" TypeEnv] @@ -78,14 +78,14 @@ ## #mappings (List (, k v)))) (def' Bindings (:' Type - (#AllT [#None "Bindings" "k" - (#AllT [#None "" "v" - (#RecordT (#Cons [["lux;counter" Int] - (#Cons [["lux;mappings" (#AppT [List - (#TupleT (#Cons [(#BoundT "k") - (#Cons [(#BoundT "v") - #Nil])]))])] - #Nil])]))])]))) + (#AllT [#None "Bindings" "k" + (#AllT [#None "" "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 @@ -94,41 +94,41 @@ ## #closure (Bindings k v))) (def' Env (:' Type - (#AllT [#None "Env" "k" - (#AllT [#None "" "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])])])]))])]))) + (#AllT [#None "Env" "k" + (#AllT [#None "" "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 (:' Type - (#TupleT (#Cons [Text (#Cons [Int (#Cons [Int #Nil])])])))) + (#TupleT (#Cons [Text (#Cons [Int (#Cons [Int #Nil])])])))) ## (deftype (Meta m v) ## (| (#Meta (, m v)))) (def' Meta (:' Type - (#AllT [#None "Meta" "m" - (#AllT [#None "" "v" - (#VariantT (#Cons [["lux;Meta" (#TupleT (#Cons [(#BoundT "m") - (#Cons [(#BoundT "v") - #Nil])]))] - #Nil]))])]))) + (#AllT [#None "Meta" "m" + (#AllT [#None "" "v" + (#VariantT (#Cons [["lux;Meta" (#TupleT (#Cons [(#BoundT "m") + (#Cons [(#BoundT "v") + #Nil])]))] + #Nil]))])]))) (export' Meta) ## (def' Reader ## (List (Meta Cursor Text))) (def' Reader (:' Type - (#AppT [List - (#AppT [(#AppT [Meta Cursor]) - Text])]))) + (#AppT [List + (#AppT [(#AppT [Meta Cursor]) + Text])]))) (export' Reader) ## (deftype HostState @@ -173,65 +173,65 @@ ## (#Record (List (, Text (w (Syntax' w))))))) (def' Syntax' (:' 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 [#None "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]) - ])])])])])])])])]) - )]) - ))))) + (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 [#None "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]) + ])])])])])])])])]) + )]) + ))))) (export' Syntax') ## (deftype Syntax ## (Meta Cursor (Syntax' (Meta Cursor)))) (def' Syntax (:' Type - (case' (#AppT [Meta Cursor]) - w - (#AppT [w (#AppT [Syntax' w])])))) + (case' (#AppT [Meta Cursor]) + w + (#AppT [w (#AppT [Syntax' w])])))) (export' Syntax) +(def' SyntaxList (#AppT [List Syntax])) + ## (deftype (Either l r) ## (| (#Left l) ## (#Right r))) (def' Either (:' Type - (#AllT [#None "_" "l" - (#AllT [#None "" "r" - (#VariantT (#Cons [["lux;Left" (#BoundT "l")] - (#Cons [["lux;Right" (#BoundT "r")] - #Nil])]))])]))) + (#AllT [#None "_" "l" + (#AllT [#None "" "r" + (#VariantT (#Cons [["lux;Left" (#BoundT "l")] + (#Cons [["lux;Right" (#BoundT "r")] + #Nil])]))])]))) (export' Either) ## (deftype Macro ## (-> (List Syntax) CompilerState -## (Either Text [CompilerState (List Syntax)]))) +## (Either Text (, CompilerState (List Syntax))))) (def' Macro (:' Type - (case' (#AppT [List Syntax]) - SyntaxList - (#LambdaT [SyntaxList - (#LambdaT [CompilerState - (#AppT [(#AppT [Either Text]) - (#TupleT (#Cons [CompilerState - (#Cons [SyntaxList - #Nil])]))])])])))) + (#LambdaT [SyntaxList + (#LambdaT [CompilerState + (#AppT [(#AppT [Either Text]) + (#TupleT (#Cons [CompilerState + (#Cons [SyntaxList + #Nil])]))])])]))) (export' Macro) ## Base functions & macros @@ -240,44 +240,44 @@ ## (#Meta [["" -1 -1] data])) (def' _meta (:' (#LambdaT [(#AppT [Syntax' - (#AppT [Meta Cursor])]) - Syntax]) - (lambda' _ data - (#Meta [["" -1 -1] data])))) + (#AppT [Meta Cursor])]) + Syntax]) + (lambda' _ data + (#Meta [["" -1 -1] data])))) ## (def (return' x) -## (-> SyntaxList CompilerState -## (Either Text (, CompilerState SyntaxList))) +## (All [a] +## (-> a CompilerState +## (Either Text (, CompilerState a)))) ## ...) (def' return' - (:' (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]))))) + (:' (#AllT [#None "" "a" + (#LambdaT [(#BoundT "a") + (#LambdaT [CompilerState + (#AppT [(#AppT [Either Text]) + (#TupleT (#Cons [CompilerState + (#Cons [(#BoundT "a") + #Nil])]))])])])]) + (lambda' _ val + (lambda' _ state + (#Right [state val]))))) ## (def (fail' msg) -## (-> Text CompilerState -## (Either Text (, CompilerState SyntaxList))) +## (All [a] +## (-> Text CompilerState +## (Either Text (, CompilerState a)))) ## ...) (def' fail' - (:' (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))))) + (:' (#AllT [#None "" "a" + (#LambdaT [Text + (#LambdaT [CompilerState + (#AppT [(#AppT [Either Text]) + (#TupleT (#Cons [CompilerState + (#Cons [(#BoundT "a") + #Nil])]))])])])]) + (lambda' _ msg + (lambda' _ state + (#Left msg))))) ## (def' let' ## (:' Macro @@ -292,54 +292,55 @@ ## (#Left "Wrong syntax for let'"))))) (def' 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])) + (lambda' _ tokens + (case' tokens + (#Cons [lhs (#Cons [rhs (#Cons [body #Nil])])]) + (return' (:' SyntaxList + (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "case'"])) + (#Cons [rhs (#Cons [lhs (#Cons [body #Nil])])])]))) + #Nil]))) - _ - (fail' "Wrong syntax for let'"))))) -(declare-macro' let') + _ + (fail' "Wrong syntax for let'"))))) (def' 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) + (lambda' _ tokens + (case' tokens + (#Cons [(#Meta [_ (#Tuple (#Cons [arg args']))]) (#Cons [body #Nil])]) + (return' (:' SyntaxList + (#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' (:' SyntaxList + (#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"))))) (export' lambda) (def' def @@ -347,48 +348,51 @@ (lambda [tokens] (case' tokens (#Cons [(#Meta [_ (#Symbol name)]) (#Cons [body #Nil])]) - (return' (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "def'"])) tokens]))) - #Nil])) + (return' (:' SyntaxList + (#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])) + (return' (:' SyntaxList + (#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])) + (return' (:' SyntaxList + (#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])) + (return' (:' SyntaxList + (#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) (export' def) (def (defmacro tokens) @@ -396,39 +400,39 @@ (case' tokens (#Cons [(#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol fn-name)]) args]))]) (#Cons [body #Nil])]) - (return' (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "def"])) - (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol fn-name)) args]))) - (#Cons [(_meta (#Symbol ["lux" "Macro"])) - (#Cons [body - #Nil])]) - ])]))) - (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "declare-macro'"])) (#Cons [(_meta (#Symbol fn-name)) #Nil])]))) - #Nil])])) + (return' (:' SyntaxList + (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "def"])) + (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol fn-name)) args]))) + (#Cons [(_meta (#Symbol ["lux" "Macro"])) + (#Cons [body + #Nil])]) + ])]))) + #Nil]))) _ (fail' "Wrong syntax for defmacro"))) -(declare-macro' defmacro) (defmacro (comment tokens) - (return' #Nil)) + (return' (:' SyntaxList #Nil))) (export' comment) (defmacro (->' tokens) (case' tokens (#Cons [input (#Cons [output #Nil])]) - (return' (#Cons [(_meta (#Form (#Cons [(_meta (#Tag ["lux" "LambdaT"])) - (#Cons [(_meta (#Tuple (#Cons [input (#Cons [output #Nil])]))) - #Nil])]))) - #Nil])) + (return' (:' SyntaxList + (#Cons [(_meta (#Form (#Cons [(_meta (#Tag ["lux" "LambdaT"])) + (#Cons [(_meta (#Tuple (#Cons [input (#Cons [output #Nil])]))) + #Nil])]))) + #Nil]))) (#Cons [input (#Cons [output others])]) - (return' (#Cons [(_meta (#Form (#Cons [(_meta (#Tag ["lux" "LambdaT"])) - (#Cons [(_meta (#Tuple (#Cons [input - (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "->'"])) - (#Cons [output others])]))) - #Nil])]))) - #Nil])]))) - #Nil])) + (return' (:' SyntaxList(#Cons [(_meta (#Form (#Cons [(_meta (#Tag ["lux" "LambdaT"])) + (#Cons [(_meta (#Tuple (#Cons [input + (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "->'"])) + (#Cons [output others])]))) + #Nil])]))) + #Nil])]))) + #Nil]))) _ (fail' "Wrong syntax for ->'"))) @@ -441,22 +445,24 @@ (case' tokens (#Cons [(#Meta [_ (#Tuple #Nil)]) (#Cons [body #Nil])]) - (return' (#Cons [body - #Nil])) + (return' (:' SyntaxList + (#Cons [body + #Nil]))) (#Cons [(#Meta [_ (#Tuple (#Cons [(#Meta [_ (#Symbol ["" arg-name])]) other-args]))]) (#Cons [body #Nil])]) - (return' (#Cons [(_meta (#Form (#Cons [(_meta (#Tag ["lux" "AllT"])) - (#Cons [(_meta (#Tuple (#Cons [(_meta (#Tag ["lux" "None"])) - (#Cons [(_meta (#Text "")) - (#Cons [(_meta (#Text arg-name)) - (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "All'"])) - (#Cons [(_meta (#Tuple other-args)) - (#Cons [body - #Nil])])]))) - #Nil])])])]))) - #Nil])]))) - #Nil])) + (return' (:' SyntaxList + (#Cons [(_meta (#Form (#Cons [(_meta (#Tag ["lux" "AllT"])) + (#Cons [(_meta (#Tuple (#Cons [(_meta (#Tag ["lux" "None"])) + (#Cons [(_meta (#Text "")) + (#Cons [(_meta (#Text arg-name)) + (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "All'"])) + (#Cons [(_meta (#Tuple other-args)) + (#Cons [body + #Nil])])]))) + #Nil])])])]))) + #Nil])]))) + #Nil]))) _ (fail' "Wrong syntax for All'"))) @@ -465,10 +471,11 @@ (case' tokens (#Cons [(#Meta [_ (#Symbol ["" bound-name])]) #Nil]) - (return' (#Cons [(_meta (#Form (#Cons [(_meta (#Tag ["lux" "BoundT"])) - (#Cons [(_meta (#Text bound-name)) - #Nil])]))) - #Nil])) + (return' (:' SyntaxList + (#Cons [(_meta (#Form (#Cons [(_meta (#Tag ["lux" "BoundT"])) + (#Cons [(_meta (#Text bound-name)) + #Nil])]))) + #Nil]))) _ (fail' "Wrong syntax for B'"))) @@ -479,12 +486,13 @@ (return' tokens) (#Cons [x (#Cons [y xs])]) - (return' (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "$'"])) - (#Cons [(_meta (#Form (#Cons [(_meta (#Tag ["lux" "AppT"])) - (#Cons [(_meta (#Tuple (#Cons [x (#Cons [y #Nil])]))) - #Nil])]))) - xs])]))) - #Nil])) + (return' (:' SyntaxList + (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "$'"])) + (#Cons [(_meta (#Form (#Cons [(_meta (#Tag ["lux" "AppT"])) + (#Cons [(_meta (#Tuple (#Cons [x (#Cons [y #Nil])]))) + #Nil])]))) + xs])]))) + #Nil]))) _ (fail' "Wrong syntax for $'"))) @@ -513,29 +521,31 @@ ($' List Syntax)) (lambda [tail head] (#Cons [head tail]))) - #Nil - list)) + #Nil + list)) (defmacro (list xs) - (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]))) + (return' (:' SyntaxList + (#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])))) (export' list) (defmacro (list& xs) (case' (reverse' xs) (#Cons [last init]) - (return' (list (fold (:' (->' Syntax Syntax Syntax) - (lambda [tail head] - (_meta (#Form (list (_meta (#Tag ["lux" "Cons"])) - (_meta (#Tuple (list head tail)))))))) - last - init))) + (return' (:' SyntaxList + (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&"))) @@ -554,19 +564,20 @@ (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))))) + (return' (:' SyntaxList + (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"))) @@ -636,13 +647,14 @@ (lambda [kv] (let [[k v] kv] [k (untemplate v)]))) - fields))) + fields))) )) (defmacro (` tokens) (case' tokens (#Cons [template #Nil]) - (return' (list (untemplate template))) + (return' (:' SyntaxList + (list (untemplate template)))) _ (fail' "Wrong syntax for `"))) @@ -651,9 +663,10 @@ (defmacro (if tokens) (case' tokens (#Cons [test (#Cons [then (#Cons [else #Nil])])]) - (return' (list (` (case' (~ test) - true (~ then) - false (~ else))))) + (return' (:' SyntaxList + (list (` (case' (~ test) + true (~ then) + false (~ else)))))) _ (fail' "Wrong syntax for if"))) @@ -845,7 +858,7 @@ ## (case' bound ## (#Macro macro) ## (#Some macro) - + ## _ ## #None)))))) @@ -863,7 +876,7 @@ ## _ ## (fail' "Macro can't expand to more than 1 output."))) - + ## #None ## (do' [args' (map% walk-type args)] ## (return (fold (:' (-> Syntax Syntax Syntax) @@ -877,7 +890,7 @@ ## (#Meta [_ (#Symbol _)]) ## (return' type) - + ## _ ## (fail' "Wrong syntax for walk-type"))) @@ -886,7 +899,7 @@ ## (#Cons [type #Nil]) ## (do' [type' (walk-type type)] ## (return' (list type'))) - + ## _ ## (fail' "Wrong syntax for ->type"))) @@ -894,7 +907,7 @@ ## (case' tokens ## (#Cons [type (#Cons [value #Nil])]) ## (return' (list (` (:' (->type (~ type)) (~ value))))) - + ## _ ## (fail' "Wrong syntax for :"))) @@ -902,7 +915,7 @@ ## (case' tokens ## (#Cons [type (#Cons [value #Nil])]) ## (return' (list (` (:!' (->type (~ type)) (~ value))))) - + ## _ ## (fail' "Wrong syntax for :!"))) diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index e85123032..2704f77ce 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -91,11 +91,6 @@ ;; (prn "if" (&/show-ast ?value))) (&&lux/analyse-def analyse ?name ?value)) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "declare-macro'"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ?ident]]] - ["lux;Nil" _]]]]]]]]] - (&&lux/analyse-declare-macro ?ident) - [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "import'"]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;Text" ?path]]] ["lux;Nil" _]]]]]]]]] diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index 28b25a492..3bba07b39 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -285,21 +285,13 @@ :let [_ (prn 'analyse-def/TYPE ?name (&type/show-type =value-type)) _ (println)] _ (&&def/define module-name ?name =value-type) + _ (if (&type/type= &type/Macro =value-type) + (&&def/declare-macro module-name ?name) + (return nil)) ;; :let [_ (prn 'analyse-def/_3)] ] (return (&/|list (&/V "Statement" (&/V "def" (&/T ?name =value))))))))) -(defn analyse-declare-macro [ident] - (|do [current-module &/get-module-name - ;; :let [_ (prn 'analyse-declare-macro/current-module current-module)] - [?module ?name] (&&/resolved-ident* ident) - ;; :let [_ (prn 'analyse-declare-macro '[?module ?name] [?module ?name])] - ] - (if (= ?module current-module) - (|do [_ (&&def/declare-macro ?module ?name)] - (return (&/|list))) - (fail "Can't declare macros from foreign modules.")))) - (defn analyse-import [analyse exo-type ?path] (return (&/|list))) diff --git a/src/lux/type.clj b/src/lux/type.clj index cd7d5be1e..82a405977 100644 --- a/src/lux/type.clj +++ b/src/lux/type.clj @@ -44,6 +44,98 @@ )))) $Void)))) +(defn fAll [name arg body] + (&/V "lux;AllT" (&/T (&/V "lux;None" nil) name arg body))) + +(def Bindings + (fAll "Bindings" "k" + (fAll "" "v" + (&/V "lux;RecordT" (&/|list (&/T "lux;counter" Int) + (&/T "lux;mappings" (&/V "lux;AppT" (&/T List + (&/V "lux;TupleT" (&/|list (&/V "lux;BoundT" "k") + (&/V "lux;BoundT" "v"))))))))))) + +(def Env + (let [bindings (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T Bindings (&/V "lux;BoundT" "k"))) + (&/V "lux;BoundT" "v")))] + (fAll "Env" "k" + (fAll "" "v" + (&/V "lux;RecordT" + (&/|list (&/T "lux;name" Text) + (&/T "lux;inner-closures" Int) + (&/T "lux;locals" bindings) + (&/T "lux;closure" bindings) + )))))) + +(def Cursor + (&/V "lux;TupleT" (&/|list Text Int Int))) + +(def Meta + (fAll "Meta" "m" + (fAll "" "v" + (&/V "lux;VariantT" (&/|list (&/T "lux;Meta" (&/V "lux;TupleT" (&/|list (&/V "lux;BoundT" "m") + (&/V "lux;BoundT" "v"))))))))) + +(def Reader + (&/V "lux;AppT" (&/T List + (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T Meta Cursor)) + Text))))) + +(def HostState + (&/V "lux;RecordT" + (&/|list (&/T "lux;writer" (&/V "lux;DataT" "org.objectweb.asm.ClassWriter")) + (&/T "lux;loader" (&/V "lux;DataT" "java.lang.ClassLoader")) + (&/T "lux;eval-ctor" Int)))) + +(def CompilerState + (&/V "lux;RecordT" + (&/|list (&/T "lux;source" (&/V "lux;AppT" (&/T Maybe Reader))) + (&/T "lux;modules" (&/V "lux;AppT" (&/T List $Void))) + (&/T "lux;module-aliases" (&/V "lux;AppT" (&/T List $Void))) + (&/T "lux;envs" (&/V "lux;AppT" (&/T List + (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T Env Text)) + $Void))))) + (&/T "lux;types" (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T Bindings Int)) Type))) + (&/T "lux;host" HostState)))) + +(def Syntax* + (let [Syntax* (&/V "lux;AppT" (&/T (&/V "lux;BoundT" "w") + (&/V "lux;AppT" (&/T (&/V "lux;BoundT" "Syntax'") + (&/V "lux;BoundT" "w"))))) + Syntax*List (&/V "lux;AppT" (&/T List Syntax*)) + Ident (&/V "lux;TupleT" (&/|list Text Text))] + (fAll "Syntax'" "w" + (&/V "lux;VariantT" (&/|list (&/T "lux;Bool" Bool) + (&/T "lux;Int" Int) + (&/T "lux;Real" Real) + (&/T "lux;Char" Char) + (&/T "lux;Text" Text) + (&/T "lux;Symbol" Ident) + (&/T "lux;Tag" Ident) + (&/T "lux;Form" Syntax*List) + (&/T "lux;Tuple" Syntax*List) + (&/T "lux;Record" (&/V "lux;AppT" (&/T List (&/V "lux;TupleT" (&/|list Text Syntax*)))))) + )))) + +(def Syntax + (let [w (&/V "lux;AppT" (&/T Meta Cursor))] + (&/V "lux;AppT" (&/T w (&/V "lux;AppT" (&/T Syntax* w)))))) + +(def Either + (fAll "_" "l" + (fAll "" "r" + (&/V "lux;VariantT" (&/|list (&/T "lux;Left" (&/V "lux;BoundT" "l")) + (&/T "lux;Right" (&/V "lux;BoundT" "r"))))))) + +(def Macro + (let [SyntaxList (&/V "lux;AppT" (&/T List Syntax))] + (&/V "lux;LambdaT" (&/T SyntaxList + (&/V "lux;LambdaT" (&/T CompilerState + (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T Either Text)) + (&/V "lux;TupleT" (&/|list CompilerState + SyntaxList)))))))) + )) + (defn bound? [id] (fn [state] (if-let [type* (->> state (&/get$ &/$TYPES) (&/get$ &/$MAPPINGS) (&/|get id))] -- cgit v1.2.3