From ab7b946a980475cad1e58186ac8c929c7659f529 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 10 May 2015 10:37:06 -0400 Subject: - Now analysing function-application backwards. --- source/lux.lux | 682 ++++++++++++++++++++++++++------------------------------- 1 file changed, 308 insertions(+), 374 deletions(-) (limited to 'source/lux.lux') diff --git a/source/lux.lux b/source/lux.lux index d2a309b5f..26425e7b8 100644 --- a/source/lux.lux +++ b/source/lux.lux @@ -351,10 +351,9 @@ (lambda' _ tokens (case' tokens (#Cons [lhs (#Cons [rhs (#Cons [body #Nil])])]) - (return (:' SyntaxList - (#Cons [($form (#Cons [($symbol ["" "case'"]) - (#Cons [rhs (#Cons [lhs (#Cons [body #Nil])])])])) - #Nil]))) + (return (#Cons [($form (#Cons [($symbol ["" "case'"]) + (#Cons [rhs (#Cons [lhs (#Cons [body #Nil])])])])) + #Nil])) _ (fail "Wrong syntax for let'"))))) @@ -365,36 +364,34 @@ (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]))) + (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 (:' 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]))) + (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"))))) @@ -403,118 +400,110 @@ (def' def_ (:' Macro (lambda_ [tokens] - (case' tokens - (#Cons [(#Meta [_ (#Tag ["" "export"])]) - (#Cons [(#Meta [_ (#Form (#Cons [name args]))]) - (#Cons [type (#Cons [body #Nil])])])]) - (return (:' SyntaxList - (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "def'"])) - (#Cons [name - (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" ":'"])) - (#Cons [type - (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "lambda_"])) - (#Cons [name - (#Cons [(_meta (#Tuple args)) - (#Cons [body #Nil])])])]))) - #Nil])])]))) - #Nil])])]))) - (#Cons [(_meta (#Form (#Cons [($symbol ["" "export'"]) (#Cons [name #Nil])]))) - #Nil])]))) - - (#Cons [(#Meta [_ (#Tag ["" "export"])]) (#Cons [name (#Cons [type (#Cons [body #Nil])])])]) - (return (:' SyntaxList - (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "def'"])) - (#Cons [name - (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" ":'"])) - (#Cons [type - (#Cons [body - #Nil])])]))) - #Nil])])]))) - (#Cons [(_meta (#Form (#Cons [($symbol ["" "export'"]) (#Cons [name #Nil])]))) - #Nil])]))) - - (#Cons [(#Meta [_ (#Form (#Cons [name args]))]) - (#Cons [type (#Cons [body #Nil])])]) - (return (:' SyntaxList - (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "def'"])) - (#Cons [name - (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" ":'"])) - (#Cons [type - (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "lambda_"])) - (#Cons [name - (#Cons [(_meta (#Tuple args)) - (#Cons [body #Nil])])])]))) - #Nil])])]))) - #Nil])])]))) - #Nil]))) - - (#Cons [name (#Cons [type (#Cons [body #Nil])])]) - (return (:' SyntaxList - (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "def'"])) - (#Cons [name - (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" ":'"])) - (#Cons [type - (#Cons [body - #Nil])])]))) - #Nil])])]))) - #Nil]))) + (case' tokens + (#Cons [(#Meta [_ (#Tag ["" "export"])]) + (#Cons [(#Meta [_ (#Form (#Cons [name args]))]) + (#Cons [type (#Cons [body #Nil])])])]) + (return (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "def'"])) + (#Cons [name + (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" ":'"])) + (#Cons [type + (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "lambda_"])) + (#Cons [name + (#Cons [(_meta (#Tuple args)) + (#Cons [body #Nil])])])]))) + #Nil])])]))) + #Nil])])]))) + (#Cons [(_meta (#Form (#Cons [($symbol ["" "export'"]) (#Cons [name #Nil])]))) + #Nil])])) + + (#Cons [(#Meta [_ (#Tag ["" "export"])]) (#Cons [name (#Cons [type (#Cons [body #Nil])])])]) + (return (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "def'"])) + (#Cons [name + (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" ":'"])) + (#Cons [type + (#Cons [body + #Nil])])]))) + #Nil])])]))) + (#Cons [(_meta (#Form (#Cons [($symbol ["" "export'"]) (#Cons [name #Nil])]))) + #Nil])])) + + (#Cons [(#Meta [_ (#Form (#Cons [name args]))]) + (#Cons [type (#Cons [body #Nil])])]) + (return (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "def'"])) + (#Cons [name + (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" ":'"])) + (#Cons [type + (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "lambda_"])) + (#Cons [name + (#Cons [(_meta (#Tuple args)) + (#Cons [body #Nil])])])]))) + #Nil])])]))) + #Nil])])]))) + #Nil])) + + (#Cons [name (#Cons [type (#Cons [body #Nil])])]) + (return (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "def'"])) + (#Cons [name + (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" ":'"])) + (#Cons [type + (#Cons [body + #Nil])])]))) + #Nil])])]))) + #Nil])) - _ - (fail "Wrong syntax for def") - )))) + _ + (fail "Wrong syntax for def") + )))) (declare-macro' def_) (def_ #export (defmacro tokens) Macro (case' tokens (#Cons [(#Meta [_ (#Form (#Cons [name args]))]) (#Cons [body #Nil])]) - (return (:' SyntaxList - (#Cons [($form (#Cons [($symbol ["lux" "def_"]) - (#Cons [($form (#Cons [name args])) - (#Cons [($symbol ["lux" "Macro"]) - (#Cons [body - #Nil])]) - ])])) - (#Cons [($form (#Cons [($symbol ["" "declare-macro'"]) (#Cons [name #Nil])])) - #Nil])]))) + (return (#Cons [($form (#Cons [($symbol ["lux" "def_"]) + (#Cons [($form (#Cons [name args])) + (#Cons [($symbol ["lux" "Macro"]) + (#Cons [body + #Nil])]) + ])])) + (#Cons [($form (#Cons [($symbol ["" "declare-macro'"]) (#Cons [name #Nil])])) + #Nil])])) (#Cons [(#Meta [_ (#Tag ["" "export"])]) (#Cons [(#Meta [_ (#Form (#Cons [name args]))]) (#Cons [body #Nil])])]) - (return (:' 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 ["" "declare-macro'"]) (#Cons [name #Nil])])) - #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 ["" "declare-macro'"]) (#Cons [name #Nil])])) + #Nil])])) _ (fail "Wrong syntax for defmacro"))) (declare-macro' defmacro) (defmacro #export (comment tokens) - (return (:' SyntaxList #Nil))) + (return #Nil)) (defmacro (->' tokens) (case' tokens (#Cons [input (#Cons [output #Nil])]) - (return (:' SyntaxList - (#Cons [(_meta (#Form (#Cons [(_meta (#Tag ["lux" "LambdaT"])) - (#Cons [(_meta (#Tuple (#Cons [input (#Cons [output #Nil])]))) - #Nil])]))) - #Nil]))) + (return (#Cons [(_meta (#Form (#Cons [(_meta (#Tag ["lux" "LambdaT"])) + (#Cons [(_meta (#Tuple (#Cons [input (#Cons [output #Nil])]))) + #Nil])]))) + #Nil])) (#Cons [input (#Cons [output others])]) - (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]))) + (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])) _ (fail "Wrong syntax for ->'"))) @@ -523,24 +512,22 @@ (case' tokens (#Cons [(#Meta [_ (#Tuple #Nil)]) (#Cons [body #Nil])]) - (return (:' SyntaxList - (#Cons [body - #Nil]))) + (return (#Cons [body + #Nil])) (#Cons [(#Meta [_ (#Tuple (#Cons [(#Meta [_ (#Symbol ["" arg-name])]) other-args]))]) (#Cons [body #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]))) + (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])) _ (fail "Wrong syntax for All'"))) @@ -549,11 +536,10 @@ (case' tokens (#Cons [(#Meta [_ (#Symbol ["" bound-name])]) #Nil]) - (return (:' SyntaxList - (#Cons [(_meta (#Form (#Cons [(_meta (#Tag ["lux" "BoundT"])) - (#Cons [(_meta (#Text bound-name)) - #Nil])]))) - #Nil]))) + (return (#Cons [(_meta (#Form (#Cons [(_meta (#Tag ["lux" "BoundT"])) + (#Cons [(_meta (#Text bound-name)) + #Nil])]))) + #Nil])) _ (fail "Wrong syntax for B'"))) @@ -564,13 +550,12 @@ (return tokens) (#Cons [x (#Cons [y xs])]) - (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]))) + (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])) _ (fail "Wrong syntax for $'"))) @@ -591,34 +576,27 @@ (def_ #export (reverse list) (All' [a] (->' ($' List (B' a)) ($' List (B' a)))) - (fold (:' (All' [a] - (->' ($' List (B' a)) (B' a) ($' List (B' a)))) - (lambda_ [tail head] - (#Cons [head tail]))) + (fold (lambda_ [tail head] (#Cons [head tail])) #Nil list)) (defmacro #export (list xs) - (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])))) + (return (#Cons [(fold (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]))) (defmacro #export (list& xs) (case' (reverse xs) (#Cons [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)))) + (return (list (fold (lambda_ [tail head] + (_meta (#Form (list (_meta (#Tag ["lux" "Cons"])) + (_meta (#Tuple (list head tail))))))) + last + init))) _ (fail "Wrong syntax for list&"))) @@ -638,19 +616,16 @@ (fail "lambda requires a non-empty arguments tuple.") (#Cons [harg targs]) - (let' body' (fold (:' (->' Syntax Syntax Syntax) - (lambda_ [body' arg] - ($form (list ($symbol ["" "lambda'"]) - ($symbol ["" ""]) - arg - body')))) - body - (reverse targs)) - (return (:' SyntaxList - (list ($form (list ($symbol ["" "lambda'"]) - ($symbol name) - harg - body'))))))) + (return (list ($form (list ($symbol ["" "lambda'"]) + ($symbol name) + harg + (fold (lambda_ [body' arg] + ($form (list ($symbol ["" "lambda'"]) + ($symbol ["" ""]) + arg + body'))) + body + (reverse targs))))))) _ (fail "Wrong syntax for lambda")))) @@ -660,43 +635,39 @@ (#Cons [(#Meta [_ (#Tag ["" "export"])]) (#Cons [(#Meta [_ (#Form (#Cons [name args]))]) (#Cons [type (#Cons [body #Nil])])])]) - (return (:' SyntaxList - (list ($form (list ($symbol ["" "def'"]) - name - ($form (list ($symbol ["" ":'"]) - type - ($form (list ($symbol ["lux" "lambda"]) - name - ($tuple args) - body)))))) - ($form (list ($symbol ["" "export'"]) name))))) + (return (list ($form (list ($symbol ["" "def'"]) + name + ($form (list ($symbol ["" ":'"]) + type + ($form (list ($symbol ["lux" "lambda"]) + name + ($tuple args) + body)))))) + ($form (list ($symbol ["" "export'"]) name)))) (#Cons [(#Meta [_ (#Tag ["" "export"])]) (#Cons [name (#Cons [type (#Cons [body #Nil])])])]) - (return (:' SyntaxList - (list ($form (list ($symbol ["" "def'"]) - name - ($form (list ($symbol ["" ":'"]) - type - body)))) - ($form (list ($symbol ["" "export'"]) name))))) + (return (list ($form (list ($symbol ["" "def'"]) + name + ($form (list ($symbol ["" ":'"]) + type + body)))) + ($form (list ($symbol ["" "export'"]) name)))) (#Cons [(#Meta [_ (#Form (#Cons [name args]))]) (#Cons [type (#Cons [body #Nil])])]) - (return (:' SyntaxList - (list ($form (list ($symbol ["" "def'"]) - name - ($form (list ($symbol ["" ":'"]) - type - ($form (list ($symbol ["lux" "lambda"]) - name - ($tuple args) - body))))))))) + (return (list ($form (list ($symbol ["" "def'"]) + name + ($form (list ($symbol ["" ":'"]) + type + ($form (list ($symbol ["lux" "lambda"]) + name + ($tuple args) + body)))))))) (#Cons [name (#Cons [type (#Cons [body #Nil])])]) - (return (:' SyntaxList - (list ($form (list ($symbol ["" "def'"]) - name - ($form (list ($symbol ["" ":'"]) type body))))))) + (return (list ($form (list ($symbol ["" "def'"]) + name + ($form (list ($symbol ["" ":'"]) type body)))))) _ (fail "Wrong syntax for def") @@ -715,20 +686,19 @@ (defmacro #export (let tokens) (case' tokens (#Cons [(#Meta [_ (#Tuple bindings)]) (#Cons [body #Nil])]) - (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)))))) + (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"))) @@ -792,12 +762,9 @@ (defmacro #export ($ tokens) (case' tokens (#Cons [op (#Cons [init args])]) - (return (:' SyntaxList - (list (fold (:' (->' Syntax Syntax Syntax) - (lambda [a1 a2] - ($form (list op a1 a2)))) - init - args)))) + (return (list (fold (lambda [a1 a2] ($form (list op a1 a2))) + init + args))) _ (fail "Wrong syntax for $"))) @@ -882,8 +849,7 @@ (defmacro (`' tokens) (case' tokens (#Cons [template #Nil]) - (return (:' SyntaxList - (list (untemplate "" template)))) + (return (list (untemplate "" template))) _ (fail "Wrong syntax for `'"))) @@ -891,17 +857,15 @@ (defmacro #export (|> tokens) (case' tokens (#Cons [init apps]) - (return (:' SyntaxList - (list (fold (:' (->' Syntax Syntax Syntax) - (lambda [acc app] - (case' app - (#Meta [_ (#Form parts)]) - ($form (list:++ parts (list acc))) - - _ - (`' ((~ app) (~ acc)))))) - init - apps)))) + (return (list (fold (lambda [acc app] + (case' app + (#Meta [_ (#Form parts)]) + ($form (list:++ parts (list acc))) + + _ + (`' ((~ app) (~ acc))))) + init + apps))) _ (fail "Wrong syntax for |>"))) @@ -909,10 +873,9 @@ (defmacro #export (if tokens) (case' tokens (#Cons [test (#Cons [then (#Cons [else #Nil])])]) - (return (:' SyntaxList - (list (`' (case' (~ test) - true (~ then) - false (~ else)))))) + (return (list (`' (case' (~ test) + true (~ then) + false (~ else))))) _ (fail "Wrong syntax for if"))) @@ -969,8 +932,7 @@ (defmacro #export (^ tokens) (case' tokens (#Cons [(#Meta [_ (#Symbol ["" class-name])]) #Nil]) - (return (:' SyntaxList - (list (`' (#;DataT (~ (_meta (#Text class-name)))))))) + (return (list (`' (#;DataT (~ (_meta (#Text class-name))))))) _ (fail "Wrong syntax for ^"))) @@ -978,19 +940,15 @@ (defmacro #export (-> tokens) (case' (reverse tokens) (#Cons [output inputs]) - (return (:' SyntaxList - (list (fold (:' (->' Syntax Syntax Syntax) - (lambda [o i] - (`' (#;LambdaT [(~ i) (~ o)])))) - output - inputs)))) + (return (list (fold (lambda [o i] (`' (#;LambdaT [(~ i) (~ o)]))) + output + inputs))) _ (fail "Wrong syntax for ->"))) (defmacro #export (, tokens) - (return (:' SyntaxList - (list (`' (#;TupleT (;list (~@ tokens)))))))) + (return (list (`' (#;TupleT (;list (~@ tokens))))))) (defmacro (do tokens) (case' tokens @@ -1004,15 +962,14 @@ _ (`' (;bind (lambda' (~ ($symbol ["" ""])) - (~ var) - (~ body')) - (~ value))))))) + (~ var) + (~ body')) + (~ value))))))) body (reverse (as-pairs bindings)))] - (return (:' SyntaxList - (list (`' (case' (~ monad) - {#;return ;return #;bind ;bind} - (~ body'))))))) + (return (list (`' (case' (~ monad) + {#;return ;return #;bind ;bind} + (~ body')))))) _ (fail "Wrong syntax for do"))) @@ -1028,13 +985,13 @@ (let [{#;return ;return #;bind _} m] (case' xs #Nil - (;return (:' List #Nil)) + (;return #Nil) (#Cons [x xs']) (do m [y (f x) ys (map% m f xs')] - (;return (:' List (#Cons [y ys])))) + (;return (#Cons [y ys]))) ))) (def__ #export (. f g) @@ -1241,19 +1198,16 @@ (#Some idents) (case' idents #Nil - (return (:' SyntaxList (list body))) + (return (list body)) (#Cons [harg targs]) (let [replacements (map (:' (-> Text (, Text Syntax)) (lambda [ident] [ident (`' (#;BoundT (~ ($text ident))))])) (list& self-ident idents)) - body' (fold (:' (-> Syntax Text Syntax) - (lambda [body' arg'] - (`' (#;AllT [#;None "" (~ ($text arg')) (~ body')])))) + body' (fold (lambda [body' arg'] (`' (#;AllT [#;None "" (~ ($text arg')) (~ body')]))) (replace-syntax replacements body) (reverse targs))] - (return (:' SyntaxList - (list (`' (#;AllT [#;None (~ ($text self-ident)) (~ ($text harg)) (~ body')]))))))) + (return (list (`' (#;AllT [#;None (~ ($text self-ident)) (~ ($text harg)) (~ body')])))))) #None (fail "'All' arguments must be symbols.")) @@ -1313,13 +1267,12 @@ (do Lux:Monad [current-module get-module-name] (let [[module name] ident] - (:' ($' Lux ($' Maybe Macro)) - (lambda [state] - (case' state - {#source source #modules modules #module-aliases module-aliases - #envs envs #types types #host host - #seed seed} - (#Right [state (find-macro' modules current-module module name)]))))))) + (lambda [state] + (case' state + {#source source #modules modules #module-aliases module-aliases + #envs envs #types types #host host + #seed seed} + (#Right [state (find-macro' modules current-module module name)])))))) (def__ (list:join xs) (All [a] @@ -1353,17 +1306,17 @@ (#Meta [_ (#Tag ident)]) (do Lux:Monad [ident (normalize ident)] - (;return (:' Syntax (`' [(~ ($text (ident->text ident))) (;,)])))) + (;return (`' [(~ ($text (ident->text ident))) (;,)]))) (#Meta [_ (#Form (#Cons [(#Meta [_ (#Tag ident)]) (#Cons [value #Nil])]))]) (do Lux:Monad [ident (normalize ident)] - (;return (:' Syntax (`' [(~ ($text (ident->text ident))) (~ value)])))) + (;return (`' [(~ ($text (ident->text ident))) (~ value)]))) _ (fail "Wrong syntax for |")))) tokens)] - (;return (:' SyntaxList (list (`' (#;VariantT (;list (~@ pairs))))))))) + (;return (list (`' (#;VariantT (;list (~@ pairs)))))))) (defmacro #export (& tokens) (if (not (multiple? 2 (length tokens))) @@ -1376,12 +1329,12 @@ [(#Meta [_ (#Tag ident)]) value] (do Lux:Monad [ident (normalize ident)] - (;return (:' Syntax (`' [(~ ($text (ident->text ident))) (~ value)])))) + (;return (`' [(~ ($text (ident->text ident))) (~ value)]))) _ (fail "Wrong syntax for &")))) (as-pairs tokens))] - (;return (:' SyntaxList (list (`' (#;RecordT (;list (~@ pairs)))))))))) + (;return (list (`' (#;RecordT (;list (~@ pairs))))))))) (def__ #export (->text x) (-> (^ java.lang.Object) Text) @@ -1446,31 +1399,31 @@ (do Lux:Monad [macro-name' (normalize macro-name) ?macro (find-macro macro-name')] - (case' (:' ($' Maybe Macro) ?macro) + (case' ?macro (#Some macro) (do Lux:Monad [expansion (macro args) expansion' (map% Lux:Monad macro-expand expansion)] - (;return (:' SyntaxList (list:join expansion')))) + (;return (list:join expansion'))) #None (do Lux:Monad [parts' (map% Lux:Monad macro-expand (list& ($symbol macro-name) args))] - (;return (:' SyntaxList (list ($form (list:join parts')))))))) + (;return (list ($form (list:join parts'))))))) (#Meta [_ (#Form (#Cons [harg targs]))]) (do Lux:Monad [harg+ (macro-expand harg) targs+ (map% Lux:Monad macro-expand targs)] - (;return (:' SyntaxList (list ($form (list:++ harg+ (list:join (:' ($' List ($' List Syntax)) targs+)))))))) + (;return (list ($form (list:++ harg+ (list:join targs+)))))) (#Meta [_ (#Tuple members)]) (do Lux:Monad [members' (map% Lux:Monad macro-expand members)] - (;return (:' SyntaxList (list ($tuple (list:join members')))))) + (;return (list ($tuple (list:join members'))))) _ - (return (:' SyntaxList (list syntax))))) + (return (list syntax)))) (def__ (walk-type type) (-> Syntax Syntax) @@ -1482,9 +1435,7 @@ ($tuple (map walk-type members)) (#Meta [_ (#Form (#Cons [type-fn args]))]) - (fold (:' (-> Syntax Syntax Syntax) - (lambda [type-fn arg] - (`' (#;AppT [(~ type-fn) (~ arg)])))) + (fold (lambda [type-fn arg] (`' (#;AppT [(~ type-fn) (~ arg)]))) (walk-type type-fn) (map walk-type args)) @@ -1496,9 +1447,9 @@ (#Cons [type #Nil]) (do Lux:Monad [type+ (macro-expand type)] - (case' (:' SyntaxList type+) + (case' type+ (#Cons [type' #Nil]) - (;return (:' SyntaxList (list (walk-type type')))) + (;return (list (walk-type type'))) _ (fail "type`: The expansion of the type-syntax had to yield a single element."))) @@ -1509,7 +1460,7 @@ (defmacro #export (: tokens) (case' tokens (#Cons [type (#Cons [value #Nil])]) - (return (:' SyntaxList (list (`' (:' (;type` (~ type)) (~ value)))))) + (return (list (`' (:' (;type` (~ type)) (~ value))))) _ (fail "Wrong syntax for :"))) @@ -1517,7 +1468,7 @@ (defmacro #export (:! tokens) (case' tokens (#Cons [type (#Cons [value #Nil])]) - (return (:' SyntaxList (list (`' (:!' (;type` (~ type)) (~ value)))))) + (return (list (`' (:!' (;type` (~ type)) (~ value))))) _ (fail "Wrong syntax for :!"))) @@ -1539,9 +1490,7 @@ (#Some [($symbol name) args type]) _ - #None)) - ] - ## (return (: (List Syntax) #Nil)) + #None))] (case' parts (#Some [name args type]) (let [with-export (: (List Syntax) @@ -1555,9 +1504,8 @@ _ (`' (;All (~ name) [(~@ args)] (~ type)))))] - (return (: (List Syntax) - (list& (`' (def' (~ name) (;type` (~ type')))) - with-export)))) + (return (list& (`' (def' (~ name) (;type` (~ type')))) + with-export))) #None (fail "Wrong syntax for deftype")) @@ -1570,8 +1518,7 @@ (case' tokens (#Cons [value #Nil]) (let [blank ($symbol ["" ""])] - (return (: (List Syntax) - (list (`' (lambda' (~ blank) (~ blank) (~ value))))))) + (return (list (`' (lambda' (~ blank) (~ blank) (~ value)))))) _ (fail "Wrong syntax for io"))) @@ -1580,12 +1527,9 @@ (case' (reverse tokens) (#Cons [value actions]) (let [dummy ($symbol ["" ""])] - (return (:' SyntaxList - (list (fold (:' (-> Syntax Syntax Syntax) - (lambda [post pre] - (`' (case' (~ pre) (~ dummy) (~ post))))) - value - actions))))) + (return (list (fold (lambda [post pre] (`' (case' (~ pre) (~ dummy) (~ post)))) + value + actions)))) _ (fail "Wrong syntax for exec"))) @@ -1630,10 +1574,10 @@ #None body'))] - (return (: (List Syntax) (list& (`' (def' (~ name) (~ body''))) - (if export? - (list (`' (export' (~ name)))) - #Nil))))) + (return (list& (`' (def' (~ name) (~ body''))) + (if export? + (list (`' (export' (~ name)))) + #Nil)))) #None (fail "Wrong syntax for def")))) @@ -1655,16 +1599,14 @@ (#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol 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: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 (: (List Syntax) - (list (`' (case' (~ value) - (~@ (|> (: (List (List (, Syntax Syntax))) expansions) list:join (map rejoin-pair) list:join)) - )))))) + (;return (list (`' (case' (~ value) + (~@ (|> expansions list:join (map rejoin-pair) list:join))))))) _ (fail "Wrong syntax for case"))) @@ -1674,9 +1616,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."))) @@ -1694,10 +1636,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 (: (List (List Syntax)) patterns')))))))) + (;return (list:join (map (lambda [pattern] (list pattern body)) + (list:join patterns')))))) _ (fail "Wrong syntax for \\or"))) @@ -1718,8 +1658,7 @@ [module-name get-module-name] (case tokens (\ (list template)) - (;return (: (List Syntax) - (list (untemplate (: Text module-name) template)))) + (;return (list (untemplate module-name template))) _ (fail "Wrong syntax for `")))) @@ -1739,7 +1678,7 @@ (-> Syntax (Lux Syntax)) (do Lux:Monad [token+ (macro-expand token)] - (case (: (List Syntax) token+) + (case token+ (\ (list token')) (;return token') @@ -1760,14 +1699,13 @@ _ (fail "Signatures require typed members!")))) - (: (List Syntax) tokens'))] - (;return (: (List Syntax) - (list (`' (#;RecordT (list (~@ (map (: (-> (, Ident Syntax) Syntax) - (lambda [pair] - (let [[name type] pair] - (`' [(~ (|> name ident->text $text)) - (~ type)])))) - (: (List (, Ident Syntax)) members))))))))))) + tokens')] + (;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)) @@ -1789,17 +1727,17 @@ #None))] (case ?parts (#Some [name args sigs]) - (let [sigs' (: Syntax (case args - #Nil - (`' (;sig (~@ sigs))) + (let [sigs' (: Syntax + (case args + #Nil + (`' (;sig (~@ sigs))) - _ - (`' (;All (~ name) [(~@ args)] (;sig (~@ sigs))))))] - (return (: (List Syntax) - (list& (`' (def' (~ name) (~ sigs'))) - (if export? - (list (`' (export' (~ name)))) - #Nil))))) + _ + (`' (;All (~ name) [(~@ args)] (;sig (~@ sigs))))))] + (return (list& (`' (def' (~ name) (~ sigs'))) + (if export? + (list (`' (export' (~ name)))) + #Nil)))) #None (fail "Wrong syntax for defsig")))) @@ -1818,9 +1756,8 @@ _ (fail "Structures require defined members!")))) - (: (List Syntax) tokens'))] - (;return (: (List Syntax) - (list ($record members)))))) + tokens')] + (;return (list ($record members))))) (defmacro #export (defstruct tokens) (let [[export? tokens'] (: (, Bool (List Syntax)) @@ -1842,17 +1779,17 @@ #None))] (case ?parts (#Some [name args type defs]) - (let [defs' (: Syntax (case args - #Nil - (`' (;struct (~@ defs))) + (let [defs' (: Syntax + (case args + #Nil + (`' (;struct (~@ defs))) - _ - (`' (;lambda (~ name) [(~@ args)] (;struct (~@ defs))))))] - (return (: (List Syntax) - (list& (`' (def (~ name) (~ type) (~ defs'))) - (if export? - (list (`' (export' (~ name)))) - #Nil))))) + _ + (`' (;lambda (~ name) [(~@ args)] (;struct (~@ defs))))))] + (return (list& (`' (def (~ name) (~ type) (~ defs'))) + (if export? + (list (`' (export' (~ name)))) + #Nil)))) #None (fail "Wrong syntax for defsig")))) @@ -1901,11 +1838,9 @@ [(defmacro #export ( tokens) (case (reverse tokens) (\ (list& last init)) - (return (: (List Syntax) - (list (fold (: (-> Syntax Syntax Syntax) - (lambda [post pre] (`
))) - last - init)))) + (return (list (fold (lambda [post pre] (` )) + last + init))) _ (fail )))] @@ -1944,10 +1879,9 @@ (list name) (list))))) lux)] - (#Right [state (map (: (-> Text Syntax) - (lambda [name] - (` ((~ ($symbol ["" "def'"])) (~ ($symbol ["" name])) - (~ ($symbol ["lux" name])))))) + (#Right [state (map (lambda [name] + (` ((~ ($symbol ["" "def'"])) (~ ($symbol ["" name])) + (~ ($symbol ["lux" name]))))) (list:join to-alias))])) #None -- cgit v1.2.3