From e351122010b5eb5bf8793382a4a4ddcf5fb3a386 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 21 Jun 2015 01:30:27 -0400 Subject: - The backwards analysis of function application is back. --- input/lux.lux | 633 ++++++++++++++++++++++++++-------------------------------- 1 file changed, 282 insertions(+), 351 deletions(-) (limited to 'input/lux.lux') diff --git a/input/lux.lux b/input/lux.lux index 6c9a50f9d..282ca97b1 100644 --- a/input/lux.lux +++ b/input/lux.lux @@ -376,10 +376,9 @@ (_lux_lambda _ tokens (_lux_case tokens (#Cons [lhs (#Cons [rhs (#Cons [body #Nil])])]) - (return (_lux_: SyntaxList - (#Cons [($form (#Cons [($symbol ["" "_lux_case"]) - (#Cons [rhs (#Cons [lhs (#Cons [body #Nil])])])])) - #Nil]))) + (return (#Cons [($form (#Cons [($symbol ["" "_lux_case"]) + (#Cons [rhs (#Cons [lhs (#Cons [body #Nil])])])])) + #Nil])) _ (fail "Wrong syntax for let'"))))) @@ -390,36 +389,34 @@ (_lux_lambda _ tokens (_lux_case tokens (#Cons [(#Meta [_ (#TupleS (#Cons [arg args']))]) (#Cons [body #Nil])]) - (return (_lux_: SyntaxList - (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_lambda"])) - (#Cons [(_meta (#SymbolS ["" ""])) - (#Cons [arg - (#Cons [(_lux_case args' - #Nil - body - - _ - (_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "lambda'"])) - (#Cons [(_meta (#TupleS args')) - (#Cons [body #Nil])])])))) - #Nil])])])]))) - #Nil]))) + (return (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_lambda"])) + (#Cons [(_meta (#SymbolS ["" ""])) + (#Cons [arg + (#Cons [(_lux_case args' + #Nil + body + + _ + (_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "lambda'"])) + (#Cons [(_meta (#TupleS args')) + (#Cons [body #Nil])])])))) + #Nil])])])]))) + #Nil])) (#Cons [(#Meta [_ (#SymbolS self)]) (#Cons [(#Meta [_ (#TupleS (#Cons [arg args']))]) (#Cons [body #Nil])])]) - (return (_lux_: SyntaxList - (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_lambda"])) - (#Cons [(_meta (#SymbolS self)) - (#Cons [arg - (#Cons [(_lux_case args' - #Nil - body - - _ - (_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "lambda'"])) - (#Cons [(_meta (#TupleS args')) - (#Cons [body #Nil])])])))) - #Nil])])])]))) - #Nil]))) + (return (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_lambda"])) + (#Cons [(_meta (#SymbolS self)) + (#Cons [arg + (#Cons [(_lux_case args' + #Nil + body + + _ + (_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "lambda'"])) + (#Cons [(_meta (#TupleS args')) + (#Cons [body #Nil])])])))) + #Nil])])])]))) + #Nil])) _ (fail "Wrong syntax for lambda"))))) @@ -432,57 +429,53 @@ (#Cons [(#Meta [_ (#TagS ["" "export"])]) (#Cons [(#Meta [_ (#FormS (#Cons [name args]))]) (#Cons [type (#Cons [body #Nil])])])]) - (return (_lux_: SyntaxList - (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_def"])) - (#Cons [name - (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_:"])) - (#Cons [type - (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "lambda'"])) - (#Cons [name - (#Cons [(_meta (#TupleS args)) - (#Cons [body #Nil])])])]))) - #Nil])])]))) - #Nil])])]))) - (#Cons [(_meta (#FormS (#Cons [($symbol ["" "_lux_export"]) (#Cons [name #Nil])]))) - #Nil])]))) + (return (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_def"])) + (#Cons [name + (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_:"])) + (#Cons [type + (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "lambda'"])) + (#Cons [name + (#Cons [(_meta (#TupleS args)) + (#Cons [body #Nil])])])]))) + #Nil])])]))) + #Nil])])]))) + (#Cons [(_meta (#FormS (#Cons [($symbol ["" "_lux_export"]) (#Cons [name #Nil])]))) + #Nil])])) (#Cons [(#Meta [_ (#TagS ["" "export"])]) (#Cons [name (#Cons [type (#Cons [body #Nil])])])]) - (return (_lux_: SyntaxList - (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_def"])) - (#Cons [name - (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_:"])) - (#Cons [type - (#Cons [body - #Nil])])]))) - #Nil])])]))) - (#Cons [(_meta (#FormS (#Cons [($symbol ["" "_lux_export"]) (#Cons [name #Nil])]))) - #Nil])]))) + (return (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_def"])) + (#Cons [name + (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_:"])) + (#Cons [type + (#Cons [body + #Nil])])]))) + #Nil])])]))) + (#Cons [(_meta (#FormS (#Cons [($symbol ["" "_lux_export"]) (#Cons [name #Nil])]))) + #Nil])])) (#Cons [(#Meta [_ (#FormS (#Cons [name args]))]) (#Cons [type (#Cons [body #Nil])])]) - (return (_lux_: SyntaxList - (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_def"])) - (#Cons [name - (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_:"])) - (#Cons [type - (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "lambda'"])) - (#Cons [name - (#Cons [(_meta (#TupleS args)) - (#Cons [body #Nil])])])]))) - #Nil])])]))) - #Nil])])]))) - #Nil]))) + (return (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_def"])) + (#Cons [name + (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_:"])) + (#Cons [type + (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "lambda'"])) + (#Cons [name + (#Cons [(_meta (#TupleS args)) + (#Cons [body #Nil])])])]))) + #Nil])])]))) + #Nil])])]))) + #Nil])) (#Cons [name (#Cons [type (#Cons [body #Nil])])]) - (return (_lux_: SyntaxList - (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_def"])) - (#Cons [name - (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_:"])) - (#Cons [type - (#Cons [body - #Nil])])]))) - #Nil])])]))) - #Nil]))) + (return (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_def"])) + (#Cons [name + (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_:"])) + (#Cons [type + (#Cons [body + #Nil])])]))) + #Nil])])]))) + #Nil])) _ (fail "Wrong syntax for def") @@ -493,53 +486,49 @@ Macro (_lux_case tokens (#Cons [(#Meta [_ (#FormS (#Cons [name args]))]) (#Cons [body #Nil])]) - (return (_lux_: SyntaxList - (#Cons [($form (#Cons [($symbol ["lux" "def'"]) + (return (#Cons [($form (#Cons [($symbol ["lux" "def'"]) + (#Cons [($form (#Cons [name args])) + (#Cons [($symbol ["lux" "Macro"]) + (#Cons [body + #Nil])]) + ])])) + (#Cons [($form (#Cons [($symbol ["" "_lux_declare-macro"]) (#Cons [name #Nil])])) + #Nil])])) + + (#Cons [(#Meta [_ (#TagS ["" "export"])]) (#Cons [(#Meta [_ (#FormS (#Cons [name args]))]) (#Cons [body #Nil])])]) + (return (#Cons [($form (#Cons [($symbol ["lux" "def'"]) + (#Cons [($tag ["" "export"]) (#Cons [($form (#Cons [name args])) (#Cons [($symbol ["lux" "Macro"]) (#Cons [body #Nil])]) - ])])) - (#Cons [($form (#Cons [($symbol ["" "_lux_declare-macro"]) (#Cons [name #Nil])])) - #Nil])]))) - - (#Cons [(#Meta [_ (#TagS ["" "export"])]) (#Cons [(#Meta [_ (#FormS (#Cons [name args]))]) (#Cons [body #Nil])])]) - (return (_lux_: SyntaxList - (#Cons [($form (#Cons [($symbol ["lux" "def'"]) - (#Cons [($tag ["" "export"]) - (#Cons [($form (#Cons [name args])) - (#Cons [($symbol ["lux" "Macro"]) - (#Cons [body - #Nil])]) - ])])])) - (#Cons [($form (#Cons [($symbol ["" "_lux_declare-macro"]) (#Cons [name #Nil])])) - #Nil])]))) + ])])])) + (#Cons [($form (#Cons [($symbol ["" "_lux_declare-macro"]) (#Cons [name #Nil])])) + #Nil])])) _ (fail "Wrong syntax for defmacro"))) (_lux_declare-macro defmacro) (defmacro #export (comment tokens) - (return (_lux_: SyntaxList #Nil))) + (return #Nil)) (defmacro (->' tokens) (_lux_case tokens (#Cons [input (#Cons [output #Nil])]) - (return (_lux_: SyntaxList - (#Cons [(_meta (#FormS (#Cons [(_meta (#TagS ["lux" "LambdaT"])) - (#Cons [(_meta (#TupleS (#Cons [input (#Cons [output #Nil])]))) - #Nil])]))) - #Nil]))) + (return (#Cons [(_meta (#FormS (#Cons [(_meta (#TagS ["lux" "LambdaT"])) + (#Cons [(_meta (#TupleS (#Cons [input (#Cons [output #Nil])]))) + #Nil])]))) + #Nil])) (#Cons [input (#Cons [output others])]) - (return (_lux_: SyntaxList - (#Cons [(_meta (#FormS (#Cons [(_meta (#TagS ["lux" "LambdaT"])) - (#Cons [(_meta (#TupleS (#Cons [input - (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "->'"])) - (#Cons [output others])]))) - #Nil])]))) - #Nil])]))) - #Nil]))) + (return (#Cons [(_meta (#FormS (#Cons [(_meta (#TagS ["lux" "LambdaT"])) + (#Cons [(_meta (#TupleS (#Cons [input + (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "->'"])) + (#Cons [output others])]))) + #Nil])]))) + #Nil])]))) + #Nil])) _ (fail "Wrong syntax for ->'"))) @@ -548,24 +537,22 @@ (_lux_case tokens (#Cons [(#Meta [_ (#TupleS #Nil)]) (#Cons [body #Nil])]) - (return (_lux_: SyntaxList - (#Cons [body - #Nil]))) + (return (#Cons [body + #Nil])) (#Cons [(#Meta [_ (#TupleS (#Cons [(#Meta [_ (#SymbolS ["" arg-name])]) other-args]))]) (#Cons [body #Nil])]) - (return (_lux_: SyntaxList - (#Cons [(_meta (#FormS (#Cons [(_meta (#TagS ["lux" "AllT"])) - (#Cons [(_meta (#TupleS (#Cons [(_meta (#TagS ["lux" "None"])) - (#Cons [(_meta (#TextS "")) - (#Cons [(_meta (#TextS arg-name)) - (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "All'"])) - (#Cons [(_meta (#TupleS other-args)) - (#Cons [body - #Nil])])]))) - #Nil])])])]))) - #Nil])]))) - #Nil]))) + (return (#Cons [(_meta (#FormS (#Cons [(_meta (#TagS ["lux" "AllT"])) + (#Cons [(_meta (#TupleS (#Cons [(_meta (#TagS ["lux" "None"])) + (#Cons [(_meta (#TextS "")) + (#Cons [(_meta (#TextS arg-name)) + (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "All'"])) + (#Cons [(_meta (#TupleS other-args)) + (#Cons [body + #Nil])])]))) + #Nil])])])]))) + #Nil])]))) + #Nil])) _ (fail "Wrong syntax for All'"))) @@ -574,11 +561,10 @@ (_lux_case tokens (#Cons [(#Meta [_ (#SymbolS ["" bound-name])]) #Nil]) - (return (_lux_: SyntaxList - (#Cons [(_meta (#FormS (#Cons [(_meta (#TagS ["lux" "BoundT"])) - (#Cons [(_meta (#TextS bound-name)) - #Nil])]))) - #Nil]))) + (return (#Cons [(_meta (#FormS (#Cons [(_meta (#TagS ["lux" "BoundT"])) + (#Cons [(_meta (#TextS bound-name)) + #Nil])]))) + #Nil])) _ (fail "Wrong syntax for B'"))) @@ -589,13 +575,12 @@ (return tokens) (#Cons [x (#Cons [y xs])]) - (return (_lux_: SyntaxList - (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "$'"])) - (#Cons [(_meta (#FormS (#Cons [(_meta (#TagS ["lux" "AppT"])) - (#Cons [(_meta (#TupleS (#Cons [x (#Cons [y #Nil])]))) - #Nil])]))) - xs])]))) - #Nil]))) + (return (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "$'"])) + (#Cons [(_meta (#FormS (#Cons [(_meta (#TagS ["lux" "AppT"])) + (#Cons [(_meta (#TupleS (#Cons [x (#Cons [y #Nil])]))) + #Nil])]))) + xs])]))) + #Nil])) _ (fail "Wrong syntax for $'"))) @@ -629,32 +614,27 @@ (def' #export (reverse list) (All' [a] (->' ($' List (B' a)) ($' List (B' a)))) - (foldL (_lux_: (All' [a] - (->' ($' List (B' a)) (B' a) ($' List (B' a)))) - (lambda' [tail head] - (#Cons [head tail]))) + (foldL (lambda' [tail head] (#Cons [head tail])) #Nil list)) (defmacro #export (list xs) - (return (_lux_: SyntaxList - (#Cons [(foldL (lambda' [tail head] - (_meta (#FormS (#Cons [(_meta (#TagS ["lux" "Cons"])) - (#Cons [(_meta (#TupleS (#Cons [head (#Cons [tail #Nil])]))) - #Nil])])))) - (_meta (#TagS ["lux" "Nil"])) - (reverse xs)) - #Nil])))) + (return (#Cons [(foldL (lambda' [tail head] + (_meta (#FormS (#Cons [(_meta (#TagS ["lux" "Cons"])) + (#Cons [(_meta (#TupleS (#Cons [head (#Cons [tail #Nil])]))) + #Nil])])))) + (_meta (#TagS ["lux" "Nil"])) + (reverse xs)) + #Nil]))) (defmacro #export (list& xs) (_lux_case (reverse xs) (#Cons [last init]) - (return (_lux_: SyntaxList - (list (foldL (lambda' [tail head] - (_meta (#FormS (list (_meta (#TagS ["lux" "Cons"])) - (_meta (#TupleS (list head tail))))))) - last - init)))) + (return (list (foldL (lambda' [tail head] + (_meta (#FormS (list (_meta (#TagS ["lux" "Cons"])) + (_meta (#TupleS (list head tail))))))) + last + init))) _ (fail "Wrong syntax for list&"))) @@ -674,17 +654,16 @@ (fail "lambda requires a non-empty arguments tuple.") (#Cons [harg targs]) - (return (_lux_: SyntaxList - (list ($form (list ($symbol ["" "_lux_lambda"]) - ($symbol name) - harg - (foldL (lambda' [body' arg] - ($form (list ($symbol ["" "_lux_lambda"]) - ($symbol ["" ""]) - arg - body'))) - body - (reverse targs)))))))) + (return (list ($form (list ($symbol ["" "_lux_lambda"]) + ($symbol name) + harg + (foldL (lambda' [body' arg] + ($form (list ($symbol ["" "_lux_lambda"]) + ($symbol ["" ""]) + arg + body'))) + body + (reverse targs))))))) _ (fail "Wrong syntax for lambda")))) @@ -694,43 +673,39 @@ (#Cons [(#Meta [_ (#TagS ["" "export"])]) (#Cons [(#Meta [_ (#FormS (#Cons [name args]))]) (#Cons [type (#Cons [body #Nil])])])]) - (return (_lux_: SyntaxList - (list ($form (list ($symbol ["" "_lux_def"]) - name - ($form (list ($symbol ["" "_lux_:"]) - type - ($form (list ($symbol ["lux" "lambda"]) - name - ($tuple args) - body)))))) - ($form (list ($symbol ["" "_lux_export"]) name))))) + (return (list ($form (list ($symbol ["" "_lux_def"]) + name + ($form (list ($symbol ["" "_lux_:"]) + type + ($form (list ($symbol ["lux" "lambda"]) + name + ($tuple args) + body)))))) + ($form (list ($symbol ["" "_lux_export"]) name)))) (#Cons [(#Meta [_ (#TagS ["" "export"])]) (#Cons [name (#Cons [type (#Cons [body #Nil])])])]) - (return (_lux_: SyntaxList - (list ($form (list ($symbol ["" "_lux_def"]) - name - ($form (list ($symbol ["" "_lux_:"]) - type - body)))) - ($form (list ($symbol ["" "_lux_export"]) name))))) + (return (list ($form (list ($symbol ["" "_lux_def"]) + name + ($form (list ($symbol ["" "_lux_:"]) + type + body)))) + ($form (list ($symbol ["" "_lux_export"]) name)))) (#Cons [(#Meta [_ (#FormS (#Cons [name args]))]) (#Cons [type (#Cons [body #Nil])])]) - (return (_lux_: SyntaxList - (list ($form (list ($symbol ["" "_lux_def"]) - name - ($form (list ($symbol ["" "_lux_:"]) - type - ($form (list ($symbol ["lux" "lambda"]) - name - ($tuple args) - body))))))))) + (return (list ($form (list ($symbol ["" "_lux_def"]) + name + ($form (list ($symbol ["" "_lux_:"]) + type + ($form (list ($symbol ["lux" "lambda"]) + name + ($tuple args) + body)))))))) (#Cons [name (#Cons [type (#Cons [body #Nil])])]) - (return (_lux_: SyntaxList - (list ($form (list ($symbol ["" "_lux_def"]) - name - ($form (list ($symbol ["" "_lux_:"]) type body))))))) + (return (list ($form (list ($symbol ["" "_lux_def"]) + name + ($form (list ($symbol ["" "_lux_:"]) type body)))))) _ (fail "Wrong syntax for def") @@ -749,19 +724,16 @@ (defmacro #export (let tokens) (_lux_case tokens (#Cons [(#Meta [_ (#TupleS bindings)]) (#Cons [body #Nil])]) - (return (_lux_: SyntaxList - (list (foldL (_lux_: (->' Syntax (#TupleT (list Syntax Syntax)) - Syntax) - (lambda [body binding] - (_lux_case binding - [label value] - (_meta (#FormS (list (_meta (#SymbolS ["lux" "let'"])) label value body)))))) - body - (foldL (_lux_: (All' [a] - (->' ($' List (B' a)) (B' a) ($' List (B' a)))) - (lambda [tail head] (#Cons [head tail]))) - #Nil - (as-pairs bindings)))))) + (return (list (foldL (_lux_: (->' Syntax (#TupleT (list Syntax Syntax)) + Syntax) + (lambda [body binding] + (_lux_case binding + [label value] + (_meta (#FormS (list (_meta (#SymbolS ["lux" "let'"])) label value body)))))) + body + (foldL (lambda [tail head] (#Cons [head tail])) + #Nil + (as-pairs bindings))))) _ (fail "Wrong syntax for let"))) @@ -825,10 +797,9 @@ (defmacro #export ($ tokens) (_lux_case tokens (#Cons [op (#Cons [init args])]) - (return (_lux_: SyntaxList - (list (foldL (lambda [a1 a2] ($form (list op a1 a2))) - init - args)))) + (return (list (foldL (lambda [a1 a2] ($form (list op a1 a2))) + init + args))) _ (fail "Wrong syntax for $"))) @@ -837,16 +808,15 @@ (->' (->' Syntax Syntax) Syntax ($' List Syntax) Syntax) (_lux_case (any? spliced? elems) true - (let [elems' (map (_lux_: (->' Syntax Syntax) - (lambda [elem] - (_lux_case elem - (#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS ["" "~@"])]) (#Cons [spliced #Nil])]))]) - spliced + (let [elems' (map (lambda [elem] + (_lux_case elem + (#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS ["" "~@"])]) (#Cons [spliced #Nil])]))]) + spliced - _ - ($form (list ($symbol ["" "_lux_:"]) - ($symbol ["lux" "SyntaxList"]) - ($form (list ($symbol ["lux" "list"]) (untemplate elem)))))))) + _ + ($form (list ($symbol ["" "_lux_:"]) + ($symbol ["lux" "SyntaxList"]) + ($form (list ($symbol ["lux" "list"]) (untemplate elem))))))) elems)] (wrap-meta ($form (list tag ($form (list& ($symbol ["lux" "$"]) @@ -913,8 +883,7 @@ (defmacro (`' tokens) (_lux_case tokens (#Cons [template #Nil]) - (return (_lux_: SyntaxList - (list (untemplate "" template)))) + (return (list (untemplate "" template))) _ (fail "Wrong syntax for `'"))) @@ -922,17 +891,15 @@ (defmacro #export (|> tokens) (_lux_case tokens (#Cons [init apps]) - (return (_lux_: SyntaxList - (list (foldL (_lux_: (->' Syntax Syntax Syntax) - (lambda [acc app] - (_lux_case app - (#Meta [_ (#FormS parts)]) - ($form (list:++ parts (list acc))) - - _ - (`' ((~ app) (~ acc)))))) - init - apps)))) + (return (list (foldL (lambda [acc app] + (_lux_case app + (#Meta [_ (#FormS parts)]) + ($form (list:++ parts (list acc))) + + _ + (`' ((~ app) (~ acc))))) + init + apps))) _ (fail "Wrong syntax for |>"))) @@ -940,10 +907,9 @@ (defmacro #export (if tokens) (_lux_case tokens (#Cons [test (#Cons [then (#Cons [else #Nil])])]) - (return (_lux_: SyntaxList - (list (`' (_lux_case (~ test) - true (~ then) - false (~ else)))))) + (return (list (`' (_lux_case (~ test) + true (~ then) + false (~ else))))) _ (fail "Wrong syntax for if"))) @@ -1000,8 +966,7 @@ (defmacro #export (^ tokens) (_lux_case tokens (#Cons [(#Meta [_ (#SymbolS ["" class-name])]) #Nil]) - (return (_lux_: SyntaxList - (list (`' (#;DataT (~ (_meta (#TextS class-name)))))))) + (return (list (`' (#;DataT (~ (_meta (#TextS class-name))))))) _ (fail "Wrong syntax for ^"))) @@ -1009,18 +974,15 @@ (defmacro #export (-> tokens) (_lux_case (reverse tokens) (#Cons [output inputs]) - (return (_lux_: SyntaxList - (list (foldL (_lux_: (->' Syntax Syntax Syntax) - (lambda [o i] (`' (#;LambdaT [(~ i) (~ o)])))) - output - inputs)))) + (return (list (foldL (lambda [o i] (`' (#;LambdaT [(~ i) (~ o)]))) + output + inputs))) _ (fail "Wrong syntax for ->"))) (defmacro #export (, tokens) - (return (_lux_: SyntaxList - (list (`' (#;TupleT (;list (~@ tokens)))))))) + (return (list (`' (#;TupleT (;list (~@ tokens))))))) (defmacro (do tokens) (_lux_case tokens @@ -1039,10 +1001,9 @@ (~ value))))))) body (reverse (as-pairs bindings)))] - (return (_lux_: SyntaxList - (list (`' (_lux_case (~ monad) - {#;return ;return #;bind ;bind} - (~ body'))))))) + (return (list (`' (_lux_case (~ monad) + {#;return ;return #;bind ;bind} + (~ body')))))) _ (fail "Wrong syntax for do"))) @@ -1058,13 +1019,13 @@ (let [{#;return ;return #;bind _} m] (_lux_case xs #Nil - (;return (_lux_: List #Nil)) + (;return #Nil) (#Cons [x xs']) (do m [y (f x) ys (map% m f xs')] - (;return (_lux_: List (#Cons [y ys])))) + (;return (#Cons [y ys]))) ))) (def'' #export (. f g) @@ -1271,20 +1232,17 @@ (#Some idents) (_lux_case idents #Nil - (return (_lux_: SyntaxList - (list body))) + (return (list body)) (#Cons [harg targs]) (let [replacements (map (_lux_: (-> Text (, Text Syntax)) (lambda [ident] [ident (`' (#;BoundT (~ ($text ident))))])) (list& self-ident idents)) - body' (foldL (_lux_: (-> Syntax Text Syntax) - (lambda [body' arg'] - (`' (#;AllT [#;None "" (~ ($text arg')) (~ body')])))) + body' (foldL (lambda [body' arg'] + (`' (#;AllT [#;None "" (~ ($text arg')) (~ body')]))) (replace-syntax replacements body) (reverse targs))] - (return (_lux_: SyntaxList - (list (`' (#;AllT [(#;Some #;Nil) (~ ($text self-ident)) (~ ($text harg)) (~ body')]))))))) + (return (list (`' (#;AllT [(#;Some #;Nil) (~ ($text self-ident)) (~ ($text harg)) (~ body')])))))) #None (fail "'All' arguments must be symbols.")) @@ -1377,18 +1335,17 @@ (#Meta [_ (#TagS ident)]) (do Lux:Monad [ident (normalize ident)] - (;return (_lux_: Syntax (`' [(~ ($text (ident->text ident))) (;,)])))) + (;return (`' [(~ ($text (ident->text ident))) (;,)]))) (#Meta [_ (#FormS (#Cons [(#Meta [_ (#TagS ident)]) (#Cons [value #Nil])]))]) (do Lux:Monad [ident (normalize ident)] - (;return (_lux_: Syntax (`' [(~ ($text (ident->text ident))) (~ value)])))) + (;return (`' [(~ ($text (ident->text ident))) (~ value)]))) _ (fail "Wrong syntax for |")))) tokens)] - (;return (_lux_: SyntaxList - (list (`' (#;VariantT (;list (~@ pairs))))))))) + (;return (list (`' (#;VariantT (;list (~@ pairs)))))))) (defmacro #export (& tokens) (if (not (multiple? 2 (length tokens))) @@ -1401,13 +1358,12 @@ [(#Meta [_ (#TagS ident)]) value] (do Lux:Monad [ident (normalize ident)] - (;return (_lux_: Syntax (`' [(~ ($text (ident->text ident))) (~ value)])))) + (;return (`' [(~ ($text (ident->text ident))) (~ value)]))) _ (fail "Wrong syntax for &")))) (as-pairs tokens))] - (;return (_lux_: SyntaxList - (list (`' (#;RecordT (;list (~@ pairs)))))))))) + (;return (list (`' (#;RecordT (;list (~@ pairs))))))))) (def'' #export (->text x) (-> (^ java.lang.Object) Text) @@ -1474,32 +1430,32 @@ (#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS macro-name)]) args]))]) (do Lux:Monad [macro-name' (normalize macro-name) - ?macro (find-macro (_lux_: Ident macro-name'))] - (_lux_case (_lux_: ($' Maybe Macro) ?macro) + ?macro (find-macro macro-name')] + (_lux_case ?macro (#Some macro) (do Lux:Monad [expansion (macro args) - expansion' (map% Lux:Monad macro-expand (_lux_: SyntaxList expansion))] - (;return (_lux_: SyntaxList (list:join (_lux_: ($' List SyntaxList) expansion'))))) + expansion' (map% Lux:Monad macro-expand expansion)] + (;return (list:join expansion'))) #None (do Lux:Monad [parts' (map% Lux:Monad macro-expand (list& ($symbol macro-name) args))] - (;return (_lux_: SyntaxList (list ($form (list:join (_lux_: ($' List SyntaxList) parts'))))))))) + (;return (list ($form (list:join parts'))))))) (#Meta [_ (#FormS (#Cons [harg targs]))]) (do Lux:Monad [harg+ (macro-expand harg) - targs+ (map% Lux:Monad macro-expand (_lux_: SyntaxList targs))] - (;return (_lux_: SyntaxList (list ($form (list:++ harg+ (list:join (_lux_: ($' List SyntaxList) targs+)))))))) + targs+ (map% Lux:Monad macro-expand targs)] + (;return (list ($form (list:++ harg+ (list:join targs+)))))) (#Meta [_ (#TupleS members)]) (do Lux:Monad [members' (map% Lux:Monad macro-expand members)] - (;return (_lux_: SyntaxList (list ($tuple (list:join (_lux_: ($' List SyntaxList) members'))))))) + (;return (list ($tuple (list:join members'))))) _ - (return (_lux_: SyntaxList (list syntax))))) + (return (list syntax)))) (def'' (walk-type type) (-> Syntax Syntax) @@ -1511,8 +1467,7 @@ ($tuple (map walk-type members)) (#Meta [_ (#FormS (#Cons [type-fn args]))]) - (foldL (_lux_: (-> Syntax Syntax Syntax) - (lambda [type-fn arg] (`' (#;AppT [(~ type-fn) (~ arg)])))) + (foldL (lambda [type-fn arg] (`' (#;AppT [(~ type-fn) (~ arg)]))) (walk-type type-fn) (map walk-type args)) @@ -1524,10 +1479,9 @@ (#Cons [type #Nil]) (do Lux:Monad [type+ (macro-expand type)] - (_lux_case (_lux_: SyntaxList type+) + (_lux_case type+ (#Cons [type' #Nil]) - (;return (_lux_: SyntaxList - (list (walk-type type')))) + (;return (list (walk-type type'))) _ (fail "type`: The expansion of the type-syntax had to yield a single element."))) @@ -1538,8 +1492,7 @@ (defmacro #export (: tokens) (_lux_case tokens (#Cons [type (#Cons [value #Nil])]) - (return (_lux_: SyntaxList - (list (`' (_lux_: (;type` (~ type)) (~ value)))))) + (return (list (`' (_lux_: (;type` (~ type)) (~ value))))) _ (fail "Wrong syntax for :"))) @@ -1547,8 +1500,7 @@ (defmacro #export (:! tokens) (_lux_case tokens (#Cons [type (#Cons [value #Nil])]) - (return (: (List Syntax) - (list (`' (_lux_:! (;type` (~ type)) (~ value)))))) + (return (list (`' (_lux_:! (;type` (~ type)) (~ value))))) _ (fail "Wrong syntax for :!"))) @@ -1584,9 +1536,8 @@ _ (`' (;All (~ name) [(~@ args)] (~ type)))))] - (return (: (List Syntax) - (list& (`' (_lux_def (~ name) (;type` (~ type')))) - with-export)))) + (return (list& (`' (_lux_def (~ name) (;type` (~ type')))) + with-export))) #None (fail "Wrong syntax for deftype")) @@ -1599,8 +1550,7 @@ (_lux_case tokens (#Cons [value #Nil]) (let [blank ($symbol ["" ""])] - (return (_lux_: SyntaxList - (list (`' (_lux_lambda (~ blank) (~ blank) (~ value))))))) + (return (list (`' (_lux_lambda (~ blank) (~ blank) (~ value)))))) _ (fail "Wrong syntax for io"))) @@ -1609,11 +1559,9 @@ (_lux_case (reverse tokens) (#Cons [value actions]) (let [dummy ($symbol ["" ""])] - (return (_lux_: SyntaxList - (list (foldL (: (-> Syntax Syntax Syntax) - (lambda [post pre] (`' (_lux_case (~ pre) (~ dummy) (~ post))))) - value - actions))))) + (return (list (foldL (lambda [post pre] (`' (_lux_case (~ pre) (~ dummy) (~ post)))) + value + actions)))) _ (fail "Wrong syntax for exec"))) @@ -1658,11 +1606,10 @@ #None body'))] - (return (: (List Syntax) - (list& (`' (_lux_def (~ name) (~ body''))) - (if export? - (list (`' (_lux_export (~ name)))) - #Nil))))) + (return (list& (`' (_lux_def (~ name) (~ body''))) + (if export? + (list (`' (_lux_export (~ name)))) + #Nil)))) #None (fail "Wrong syntax for def")))) @@ -1684,16 +1631,14 @@ (#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS macro-name)]) macro-args]))]) (do Lux:Monad [expansion (macro-expand ($form (list& ($symbol macro-name) body macro-args))) - expansions (map% Lux:Monad expander (as-pairs (: (List Syntax) expansion)))] - (;return (: (List (, Syntax Syntax)) (list:join (: (List (List (, Syntax Syntax))) expansions))))) + expansions (map% Lux:Monad expander (as-pairs expansion))] + (;return (list:join expansions))) _ - (;return (: (List (, Syntax Syntax)) (list branch))))))) + (;return (list branch)))))) (as-pairs branches))] - (;return (_lux_: SyntaxList - (list (`' (_lux_case (~ value) - (~@ (|> (: (List (List (, Syntax Syntax))) expansions) - list:join (map rejoin-pair) list:join)))))))) + (;return (list (`' (_lux_case (~ value) + (~@ (|> expansions list:join (map rejoin-pair) list:join))))))) _ (fail "Wrong syntax for case"))) @@ -1703,10 +1648,9 @@ (#Cons [body (#Cons [pattern #Nil])]) (do Lux:Monad [pattern+ (macro-expand pattern)] - (case (: (List Syntax) pattern+) + (case pattern+ (#Cons [pattern' #Nil]) - (;return (: (List Syntax) - (list pattern' body))) + (;return (list pattern' body)) _ (fail "\\ can only expand to 1 pattern."))) @@ -1724,10 +1668,8 @@ _ (do Lux:Monad [patterns' (map% Lux:Monad macro-expand patterns)] - (;return (: (List Syntax) - (list:join (map (: (-> Syntax (List Syntax)) - (lambda [pattern] (list pattern body))) - (list:join patterns'))))))) + (;return (list:join (map (lambda [pattern] (list pattern body)) + (list:join patterns')))))) _ (fail "Wrong syntax for \\or"))) @@ -1748,8 +1690,7 @@ [module-name get-module-name] (case tokens (\ (list template)) - (;return (_lux_: SyntaxList - (list (untemplate module-name template)))) + (;return (list (untemplate module-name template))) _ (fail "Wrong syntax for `")))) @@ -1769,7 +1710,7 @@ (-> Syntax (Lux Syntax)) (do Lux:Monad [token+ (macro-expand token)] - (case (: (List Syntax) token+) + (case token+ (\ (list token')) (;return token') @@ -1791,13 +1732,12 @@ _ (fail "Signatures require typed members!")))) tokens')] - (;return (: (List Syntax) - (list (`' (#;RecordT (list (~@ (map (: (-> (, Ident Syntax) Syntax) - (lambda [pair] - (let [[name type] pair] - (`' [(~ (|> name ident->text $text)) - (~ type)])))) - members)))))))))) + (;return (list (`' (#;RecordT (list (~@ (map (: (-> (, Ident Syntax) Syntax) + (lambda [pair] + (let [[name type] pair] + (`' [(~ (|> name ident->text $text)) + (~ type)])))) + members))))))))) (defmacro #export (defsig tokens) (let [[export? tokens'] (: (, Bool (List Syntax)) @@ -1826,11 +1766,10 @@ _ (`' (;All (~ name) [(~@ args)] (;sig (~@ sigs))))))] - (return (: (List Syntax) - (list& (`' (_lux_def (~ name) (~ sigs'))) - (if export? - (list (`' (_lux_export (~ name)))) - #Nil))))) + (return (list& (`' (_lux_def (~ name) (~ sigs'))) + (if export? + (list (`' (_lux_export (~ name)))) + #Nil)))) #None (fail "Wrong syntax for defsig")))) @@ -1850,8 +1789,7 @@ _ (fail "Structures require defined members!")))) tokens')] - (;return (: (List Syntax) - (list ($record members)))))) + (;return (list ($record members))))) (defmacro #export (defstruct tokens) (let [[export? tokens'] (: (, Bool (List Syntax)) @@ -1880,11 +1818,10 @@ _ (`' (;lambda (~ name) [(~@ args)] (;struct (~@ defs))))))] - (return (: (List Syntax) - (list& (`' (def (~ name) (~ type) (~ defs'))) - (if export? - (list (`' (_lux_export (~ name)))) - #Nil))))) + (return (list& (`' (def (~ name) (~ type) (~ defs'))) + (if export? + (list (`' (_lux_export (~ name)))) + #Nil)))) #None (fail "Wrong syntax for defsig")))) @@ -1933,11 +1870,9 @@ [(defmacro #export ( tokens) (case (reverse tokens) (\ (list& last init)) - (return (: (List Syntax) - (list (foldL (: (-> Syntax Syntax Syntax) - (lambda [post pre] (`
))) - last - init)))) + (return (list (foldL (lambda [post pre] (` )) + last + init))) _ (fail )))] @@ -1982,11 +1917,9 @@ (list))))) (let [{#module-aliases _ #defs defs #imports _} lux] defs))] - (#Right [state (: (List Syntax) - (map (: (-> Text Syntax) - (lambda [name] - (` ((~ ($symbol ["" "_lux_def"])) (~ ($symbol ["" name])) (~ ($symbol ["lux" name])))))) - (list:join to-alias)))])) + (#Right [state (map (lambda [name] + (` ((~ ($symbol ["" "_lux_def"])) (~ ($symbol ["" name])) (~ ($symbol ["lux" name]))))) + (list:join to-alias))])) #None (#Left "Uh, oh... The universe is not working properly...")) @@ -2091,19 +2024,17 @@ [module name] (split-slot sname)] [($tag [module name]) ($symbol ["" name])]))) slots))] - (#Right [state (: (List Syntax) - (list (` (_lux_case (~ struct) (~ pattern) (~ body)))))])) + (#Right [state (list (` (_lux_case (~ struct) (~ pattern) (~ body))))])) _ (#Left "Can only \"use\" records.")))))) _ (let [dummy ($symbol ["" ""])] - (#Right [state (: (List Syntax) - (list (` (_lux_case (~ struct) - (~ dummy) - (using (~ dummy) - (~ body))))))]))) + (#Right [state (list (` (_lux_case (~ struct) + (~ dummy) + (using (~ dummy) + (~ body)))))]))) _ (#Left "Wrong syntax for defsig"))) -- cgit v1.2.3