diff options
Diffstat (limited to '')
-rw-r--r-- | source/lux.lux | 516 |
1 files changed, 258 insertions, 258 deletions
diff --git a/source/lux.lux b/source/lux.lux index 0ce03829b..9e5fbea7b 100644 --- a/source/lux.lux +++ b/source/lux.lux @@ -826,16 +826,16 @@ (#Cons [_ (#TupleS args)] (#Cons body #Nil)) (parse-univq-args args (lambda'' [names] - (let'' body' (foldL (_lux_: (#LambdaT AST (#LambdaT Text AST)) - (lambda'' [body' name'] - (form$ (#Cons (tag$ ["lux" "UnivQ"]) - (#Cons (tag$ ["lux" "Nil"]) - (#Cons (replace-syntax (#Cons [name' (make-bound 1)] #Nil) - (update-bounds body')) #Nil)))))) - (replace-syntax (#Cons [self-name (make-bound -2)] #Nil) - body) - names) - (return (#Cons body' #Nil))))) + (let'' body' (foldL (_lux_: (#LambdaT AST (#LambdaT Text AST)) + (lambda'' [body' name'] + (form$ (#Cons (tag$ ["lux" "UnivQ"]) + (#Cons (tag$ ["lux" "Nil"]) + (#Cons (replace-syntax (#Cons [name' (make-bound 1)] #Nil) + (update-bounds body')) #Nil)))))) + (replace-syntax (#Cons [self-name (make-bound -2)] #Nil) + body) + names) + (return (#Cons body' #Nil))))) _ (fail "Wrong syntax for All")) @@ -859,7 +859,7 @@ _ (fail "Wrong syntax for ->"))) -(defmacro (list xs) +(defmacro (@list xs) (return (#Cons (foldL (lambda'' [tail head] (form$ (#Cons (tag$ ["lux" "Cons"]) (#Cons (tuple$ (#Cons [head (#Cons [tail #Nil])])) @@ -868,31 +868,31 @@ (reverse xs)) #Nil))) -(defmacro (list& xs) +(defmacro (@list& xs) (_lux_case (reverse xs) (#Cons last init) - (return (list (foldL (lambda'' [tail head] - (form$ (list (tag$ ["lux" "Cons"]) - (tuple$ (list head tail))))) - last - init))) + (return (@list (foldL (lambda'' [tail head] + (form$ (@list (tag$ ["lux" "Cons"]) + (tuple$ (@list head tail))))) + last + init))) _ - (fail "Wrong syntax for list&"))) + (fail "Wrong syntax for @list&"))) (defmacro #export (^ tokens) (_lux_case tokens (#Cons [_ (#SymbolS "" class-name)] #Nil) - (return (list (form$ (list (tag$ ["lux" "DataT"]) (text$ class-name))))) + (return (@list (form$ (@list (tag$ ["lux" "DataT"]) (text$ class-name))))) _ (fail "Wrong syntax for ^"))) (defmacro #export (, tokens) - (return (list (form$ (list (tag$ ["lux" "TupleT"]) - (foldL (lambda'' [tail head] (form$ (list (tag$ ["lux" "Cons"]) head tail))) - (tag$ ["lux" "Nil"]) - (reverse tokens))))))) + (return (@list (form$ (@list (tag$ ["lux" "TupleT"]) + (foldL (lambda'' [tail head] (form$ (@list (tag$ ["lux" "Cons"]) head tail))) + (tag$ ["lux" "Nil"]) + (reverse tokens))))))) (defmacro (lambda' tokens) (let'' [name tokens'] (_lux_: (, Text ($' List AST)) @@ -909,16 +909,16 @@ (fail "lambda' requires a non-empty arguments tuple.") (#Cons [harg 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))))))) + (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'")))) @@ -928,39 +928,39 @@ (#Cons [[_ (#TagS ["" "export"])] (#Cons [[_ (#FormS (#Cons [name args]))] (#Cons [type (#Cons [body #Nil])])])]) - (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)))) + (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 [[_ (#TagS ["" "export"])] (#Cons [name (#Cons [type (#Cons [body #Nil])])])]) - (return (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 [[_ (#FormS (#Cons [name args]))] (#Cons [type (#Cons [body #Nil])])]) - (return (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 (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'") @@ -978,14 +978,14 @@ (defmacro (let' tokens) (_lux_case tokens (#Cons [[_ (#TupleS bindings)] (#Cons [body #Nil])]) - (return (list (foldL (_lux_: (-> AST (, AST AST) - AST) - (lambda' [body binding] - (_lux_case binding - [label value] - (form$ (list (symbol$ ["" "_lux_case"]) value label body))))) - body - (reverse (as-pairs bindings))))) + (return (@list (foldL (_lux_: (-> AST (, AST AST) + AST) + (lambda' [body binding] + (_lux_case binding + [label value] + (form$ (@list (symbol$ ["" "_lux_case"]) value label body))))) + body + (reverse (as-pairs bindings))))) _ (fail "Wrong syntax for let'"))) @@ -1013,8 +1013,8 @@ (def''' (wrap-meta content) (-> AST AST) - (tuple$ (list (tuple$ (list (text$ "") (int$ -1) (int$ -1))) - content))) + (tuple$ (@list (tuple$ (@list (text$ "") (int$ -1) (int$ -1))) + content))) (def''' (untemplate-list tokens) (-> ($' List AST) AST) @@ -1023,7 +1023,7 @@ (_meta (#TagS ["lux" "Nil"])) (#Cons [token tokens']) - (_meta (#FormS (list (_meta (#TagS ["lux" "Cons"])) token (untemplate-list tokens')))))) + (_meta (#FormS (@list (_meta (#TagS ["lux" "Cons"])) token (untemplate-list tokens')))))) (def''' #export (list:++ xs ys) (All [a] (-> ($' List a) ($' List a) ($' List a))) @@ -1037,9 +1037,9 @@ (defmacro #export ($ tokens) (_lux_case tokens (#Cons op (#Cons init args)) - (return (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 $"))) @@ -1105,18 +1105,18 @@ (let' [[var value] binding] (_lux_case var [_ (#TagS "" "let")] - (form$ (list (symbol$ ["lux" "let'"]) value body')) + (form$ (@list (symbol$ ["lux" "let'"]) value body')) _ - (form$ (list g!bind - (form$ (list (symbol$ ["" "_lux_lambda"]) (symbol$ ["" ""]) var body')) - value)))))) + (form$ (@list g!bind + (form$ (@list (symbol$ ["" "_lux_lambda"]) (symbol$ ["" ""]) var body')) + value)))))) body (reverse (as-pairs bindings)))] - (return (list (form$ (list (symbol$ ["" "_lux_case"]) - monad - (record$ (list [(tag$ ["lux" "return"]) g!wrap] [(tag$ ["lux" "bind"]) g!bind])) - body'))))) + (return (@list (form$ (@list (symbol$ ["" "_lux_case"]) + monad + (record$ (@list [(tag$ ["lux" "return"]) g!wrap] [(tag$ ["lux" "bind"]) g!bind])) + body'))))) _ (fail "Wrong syntax for do"))) @@ -1144,9 +1144,9 @@ (defmacro #export (if tokens) (_lux_case tokens (#Cons test (#Cons then (#Cons else #Nil))) - (return (list (form$ (list (symbol$ ["" "_lux_case"]) test - (bool$ true) then - (bool$ false) else)))) + (return (@list (form$ (@list (symbol$ ["" "_lux_case"]) test + (bool$ true) then + (bool$ false) else)))) _ (fail "Wrong syntax for if"))) @@ -1168,7 +1168,7 @@ (-> Text a ($' List (, Text a)) ($' List (, Text a)))) (_lux_case dict #Nil - (list [k v]) + (@list [k v]) (#Cons [[k' v'] dict']) (if (text:= k k') @@ -1227,41 +1227,41 @@ _ (do Lux/Monad [=elem (untemplate elem)] - (wrap (form$ (list (symbol$ ["" "_lux_:"]) - (form$ (list (tag$ ["lux" "AppT"]) (tuple$ (list (symbol$ ["lux" "List"]) (symbol$ ["lux" "AST"]))))) - (form$ (list (tag$ ["lux" "Cons"]) (tuple$ (list =elem (tag$ ["lux" "Nil"])))))))))))) + (wrap (form$ (@list (symbol$ ["" "_lux_:"]) + (form$ (@list (tag$ ["lux" "AppT"]) (tuple$ (@list (symbol$ ["lux" "List"]) (symbol$ ["lux" "AST"]))))) + (form$ (@list (tag$ ["lux" "Cons"]) (tuple$ (@list =elem (tag$ ["lux" "Nil"])))))))))))) elems))] - (wrap (wrap-meta (form$ (list tag - (form$ (list& (symbol$ ["lux" "$"]) - (symbol$ ["lux" "list:++"]) - elems'))))))) + (wrap (wrap-meta (form$ (@list tag + (form$ (@list& (symbol$ ["lux" "$"]) + (symbol$ ["lux" "list:++"]) + elems'))))))) false (do Lux/Monad [=elems (map% Lux/Monad untemplate elems)] - (wrap (wrap-meta (form$ (list tag (untemplate-list =elems))))))) + (wrap (wrap-meta (form$ (@list tag (untemplate-list =elems))))))) false (do Lux/Monad [=elems (map% Lux/Monad untemplate elems)] - (wrap (wrap-meta (form$ (list tag (untemplate-list =elems)))))))) + (wrap (wrap-meta (form$ (@list tag (untemplate-list =elems)))))))) (def''' (untemplate replace? subst token) (-> Bool Text AST ($' Lux AST)) (_lux_case (_lux_: (, Bool AST) [replace? token]) [_ [_ (#BoolS value)]] - (return (wrap-meta (form$ (list (tag$ ["lux" "BoolS"]) (_meta (#BoolS value)))))) + (return (wrap-meta (form$ (@list (tag$ ["lux" "BoolS"]) (_meta (#BoolS value)))))) [_ [_ (#IntS value)]] - (return (wrap-meta (form$ (list (tag$ ["lux" "IntS"]) (_meta (#IntS value)))))) + (return (wrap-meta (form$ (@list (tag$ ["lux" "IntS"]) (_meta (#IntS value)))))) [_ [_ (#RealS value)]] - (return (wrap-meta (form$ (list (tag$ ["lux" "RealS"]) (_meta (#RealS value)))))) + (return (wrap-meta (form$ (@list (tag$ ["lux" "RealS"]) (_meta (#RealS value)))))) [_ [_ (#CharS value)]] - (return (wrap-meta (form$ (list (tag$ ["lux" "CharS"]) (_meta (#CharS value)))))) + (return (wrap-meta (form$ (@list (tag$ ["lux" "CharS"]) (_meta (#CharS value)))))) [_ [_ (#TextS value)]] - (return (wrap-meta (form$ (list (tag$ ["lux" "TextS"]) (_meta (#TextS value)))))) + (return (wrap-meta (form$ (@list (tag$ ["lux" "TextS"]) (_meta (#TextS value)))))) [_ [_ (#TagS [module name])]] (let' [module' (_lux_case module @@ -1270,7 +1270,7 @@ _ module)] - (return (wrap-meta (form$ (list (tag$ ["lux" "TagS"]) (tuple$ (list (text$ module') (text$ name)))))))) + (return (wrap-meta (form$ (@list (tag$ ["lux" "TagS"]) (tuple$ (@list (text$ module') (text$ name)))))))) [true [_ (#SymbolS [module name])]] (do Lux/Monad @@ -1281,10 +1281,10 @@ _ (wrap (_lux_: Ident [module name]))) #let [[module name] real-name]] - (return (wrap-meta (form$ (list (tag$ ["lux" "SymbolS"]) (tuple$ (list (text$ module) (text$ name)))))))) + (return (wrap-meta (form$ (@list (tag$ ["lux" "SymbolS"]) (tuple$ (@list (text$ module) (text$ name)))))))) [false [_ (#SymbolS [module name])]] - (return (wrap-meta (form$ (list (tag$ ["lux" "SymbolS"]) (tuple$ (list (text$ module) (text$ name))))))) + (return (wrap-meta (form$ (@list (tag$ ["lux" "SymbolS"]) (tuple$ (@list (text$ module) (text$ name))))))) [_ [_ (#TupleS elems)]] (splice replace? (untemplate replace? subst) (tag$ ["lux" "TupleS"]) elems) @@ -1307,9 +1307,9 @@ (do Lux/Monad [=k (untemplate replace? subst k) =v (untemplate replace? subst v)] - (wrap (tuple$ (list =k =v))))))) + (wrap (tuple$ (@list =k =v))))))) fields)] - (wrap (wrap-meta (form$ (list (tag$ ["lux" "RecordS"]) (untemplate-list =fields)))))) + (wrap (wrap-meta (form$ (@list (tag$ ["lux" "RecordS"]) (untemplate-list =fields)))))) )) (def'' (get-module-name state) @@ -1332,7 +1332,7 @@ (do Lux/Monad [current-module get-module-name =template (untemplate true current-module template)] - (wrap (list =template))) + (wrap (@list =template))) _ (fail "Wrong syntax for `"))) @@ -1342,7 +1342,7 @@ (#Cons template #Nil) (do Lux/Monad [=template (untemplate false "" template)] - (wrap (list =template))) + (wrap (@list =template))) _ (fail "Wrong syntax for '"))) @@ -1350,19 +1350,19 @@ (defmacro #export (|> tokens) (_lux_case tokens (#Cons [init apps]) - (return (list (foldL (_lux_: (-> AST AST AST) - (lambda' [acc app] - (_lux_case app - [_ (#TupleS parts)] - (tuple$ (list:++ parts (list acc))) + (return (@list (foldL (_lux_: (-> AST AST AST) + (lambda' [acc app] + (_lux_case app + [_ (#TupleS parts)] + (tuple$ (list:++ parts (@list acc))) - [_ (#FormS parts)] - (form$ (list:++ parts (list acc))) + [_ (#FormS parts)] + (form$ (list:++ parts (@list acc))) - _ - (` ((~ app) (~ acc)))))) - init - apps))) + _ + (` ((~ app) (~ acc)))))) + init + apps))) _ (fail "Wrong syntax for |>"))) @@ -1577,7 +1577,7 @@ xs (#Cons [x xs']) - (list& x sep (interpose sep xs')))) + (@list& x sep (interpose sep xs')))) (def''' (macro-expand token) (-> AST ($' Lux ($' List AST))) @@ -1594,10 +1594,10 @@ (wrap (list:join expansion'))) #None - (return (list token)))) + (return (@list token)))) _ - (return (list token)))) + (return (@list token)))) (def''' (macro-expand-all syntax) (-> AST ($' Lux ($' List AST))) @@ -1615,22 +1615,22 @@ #None (do Lux/Monad - [parts' (map% Lux/Monad macro-expand-all (list& (symbol$ macro-name) args))] - (wrap (list (form$ (list:join parts'))))))) + [parts' (map% Lux/Monad macro-expand-all (@list& (symbol$ macro-name) args))] + (wrap (@list (form$ (list:join parts'))))))) [_ (#FormS (#Cons [harg targs]))] (do Lux/Monad [harg+ (macro-expand-all harg) targs+ (map% Lux/Monad macro-expand-all targs)] - (wrap (list (form$ (list:++ harg+ (list:join targs+)))))) + (wrap (@list (form$ (list:++ harg+ (list:join targs+)))))) [_ (#TupleS members)] (do Lux/Monad [members' (map% Lux/Monad macro-expand-all members)] - (wrap (list (tuple$ (list:join members'))))) + (wrap (@list (tuple$ (list:join members'))))) _ - (return (list syntax)))) + (return (@list syntax)))) (def''' (walk-type type) (-> AST AST) @@ -1650,25 +1650,25 @@ _ type)) -(defmacro #export (type tokens) +(defmacro #export (@type tokens) (_lux_case tokens (#Cons type #Nil) (do Lux/Monad [type+ (macro-expand-all type)] (_lux_case type+ (#Cons type' #Nil) - (wrap (list (walk-type type'))) + (wrap (@list (walk-type type'))) _ (fail "The expansion of the type-syntax had to yield a single element."))) _ - (fail "Wrong syntax for type"))) + (fail "Wrong syntax for @type"))) (defmacro #export (: tokens) (_lux_case tokens (#Cons type (#Cons value #Nil)) - (return (list (` (;_lux_: (;type (~ type)) (~ value))))) + (return (@list (` (;_lux_: (@type (~ type)) (~ value))))) _ (fail "Wrong syntax for :"))) @@ -1676,7 +1676,7 @@ (defmacro #export (:! tokens) (_lux_case tokens (#Cons type (#Cons value #Nil)) - (return (list (` (;_lux_:! (type (~ type)) (~ value))))) + (return (@list (` (;_lux_:! (@type (~ type)) (~ value))))) _ (fail "Wrong syntax for :!"))) @@ -1774,21 +1774,21 @@ [type tags??] type+tags?? with-export (: (List AST) (if export? - (list (` (;_lux_export (~ type-name)))) + (@list (` (;_lux_export (~ type-name)))) #Nil)) with-tags (: (List AST) (_lux_case tags?? (#Some tags) - (list (` (;_lux_declare-tags [(~@ tags)] (~ type-name)))) + (@list (` (;_lux_declare-tags [(~@ tags)] (~ type-name)))) _ - (list))) + (@list))) type' (: (Maybe AST) (if rec? (if (empty? args) (let' [g!param (symbol$ ["" ""]) prime-name (symbol$ ["" (text:++ name "'")]) - type+ (replace-syntax (list [name (` ((~ prime-name) (~ g!param)))]) type)] + type+ (replace-syntax (@list [name (` ((~ prime-name) (~ g!param)))]) type)] (#Some (` ((All (~ prime-name) [(~ g!param)] (~ type+)) Void)))) #None) @@ -1800,10 +1800,10 @@ (#Some (` (All (~ type-name) [(~@ args)] (~ type)))))))] (_lux_case type' (#Some type'') - (return (list& (` (;_lux_def (~ type-name) (type (#;NamedT [(~ (text$ module-name)) - (~ (text$ name))] - (~ type''))))) - (list:++ with-export with-tags))) + (return (@list& (` (;_lux_def (~ type-name) (@type (#;NamedT [(~ (text$ module-name)) + (~ (text$ name))] + (~ type''))))) + (list:++ with-export with-tags))) #None (fail "Wrong syntax for deftype")))) @@ -1816,10 +1816,10 @@ (_lux_case (reverse tokens) (#Cons value actions) (let' [dummy (symbol$ ["" ""])] - (return (list (foldL (_lux_: (-> AST AST AST) - (lambda' [post pre] (` (;_lux_case (~ pre) (~ dummy) (~ post))))) - value - actions)))) + (return (@list (foldL (_lux_: (-> AST AST AST) + (lambda' [post pre] (` (;_lux_case (~ pre) (~ dummy) (~ post))))) + value + actions)))) _ (fail "Wrong syntax for exec"))) @@ -1864,10 +1864,10 @@ #None body'))] - (return (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'")))) @@ -1875,7 +1875,7 @@ (def' (rejoin-pair pair) (-> (, AST AST) (List AST)) (let' [[left right] pair] - (list left right))) + (@list left right))) (defmacro #export (case tokens) (_lux_case tokens @@ -1888,15 +1888,15 @@ (_lux_case pattern [_ (#FormS (#Cons [_ (#SymbolS macro-name)] macro-args))] (do Lux/Monad - [expansion (macro-expand (form$ (list& (symbol$ macro-name) body macro-args))) + [expansion (macro-expand (form$ (@list& (symbol$ macro-name) body macro-args))) expansions (map% Lux/Monad expander (as-pairs expansion))] (wrap (list:join expansions))) _ - (wrap (list branch)))))) + (wrap (@list branch)))))) (as-pairs branches))] - (wrap (list (` (;_lux_case (~ value) - (~@ (|> expansions list:join (map rejoin-pair) list:join))))))) + (wrap (@list (` (;_lux_case (~ value) + (~@ (|> expansions list:join (map rejoin-pair) list:join))))))) _ (fail "Wrong syntax for case"))) @@ -1908,7 +1908,7 @@ [pattern+ (macro-expand-all pattern)] (case pattern+ (#Cons pattern' #Nil) - (wrap (list pattern' body)) + (wrap (@list pattern' body)) _ (fail "\\ can only expand to 1 pattern."))) @@ -1926,7 +1926,7 @@ _ (do Lux/Monad [patterns' (map% Lux/Monad macro-expand-all patterns)] - (wrap (list:join (map (lambda' [pattern] (list pattern body)) + (wrap (list:join (map (lambda' [pattern] (@list pattern body)) (list:join patterns')))))) _ @@ -1943,7 +1943,7 @@ (defmacro #export (let tokens) (case tokens - (\ (list [_ (#TupleS bindings)] body)) + (\ (@list [_ (#TupleS bindings)] body)) (if (multiple? 2 (length bindings)) (|> bindings as-pairs reverse (foldL (: (-> AST (, AST AST) AST) @@ -1953,7 +1953,7 @@ (` (;_lux_case (~ r) (~ l) (~ body'))) (` (case (~ r) (~ l) (~ body'))))))) body) - list + @list return) (fail "let requires an even number of parts")) @@ -1999,10 +1999,10 @@ (defmacro #export (lambda tokens) (case (: (Maybe (, Ident AST (List AST) AST)) (case tokens - (\ (list [_ (#TupleS (#Cons head tail))] body)) + (\ (@list [_ (#TupleS (#Cons head tail))] body)) (#Some ["" ""] head tail body) - (\ (list [_ (#SymbolS ["" name])] [_ (#TupleS (#Cons head tail))] body)) + (\ (@list [_ (#SymbolS ["" name])] [_ (#TupleS (#Cons head tail))] body)) (#Some ["" name] head tail body) _ @@ -2018,9 +2018,9 @@ (case (~ g!blank) (~ arg) (~ body'))))))) body (reverse tail)))] - (return (list (if (symbol? head) - (` (;_lux_lambda (~ g!name) (~ head) (~ body+))) - (` (;_lux_lambda (~ g!name) (~ g!blank) (case (~ g!blank) (~ head) (~ body+)))))))) + (return (@list (if (symbol? head) + (` (;_lux_lambda (~ g!name) (~ head) (~ body+))) + (` (;_lux_lambda (~ g!name) (~ g!blank) (case (~ g!blank) (~ head) (~ body+)))))))) #None (fail "Wrong syntax for lambda"))) @@ -2035,16 +2035,16 @@ [false tokens])) parts (: (Maybe (, AST (List AST) (Maybe AST) AST)) (case tokens' - (\ (list [_ (#FormS (#Cons name args))] type body)) + (\ (@list [_ (#FormS (#Cons name args))] type body)) (#Some name args (#Some type) body) - (\ (list name type body)) + (\ (@list name type body)) (#Some name #Nil (#Some type) body) - (\ (list [_ (#FormS (#Cons name args))] body)) + (\ (@list [_ (#FormS (#Cons name args))] body)) (#Some name args #None body) - (\ (list name body)) + (\ (@list name body)) (#Some name #Nil #None body) _ @@ -2065,10 +2065,10 @@ #None body))] - (return (list& (` (;_lux_def (~ name) (~ body))) - (if export? - (list (` (;_lux_export (~ name)))) - (list))))) + (return (@list& (` (;_lux_def (~ name) (~ body))) + (if export? + (@list (` (;_lux_export (~ name)))) + (@list))))) #None (fail "Wrong syntax for def")))) @@ -2089,17 +2089,17 @@ (defmacro #export (defsig tokens) (let [[export? tokens'] (: (, Bool (List AST)) (case tokens - (\ (list& [_ (#TagS "" "export")] tokens')) + (\ (@list& [_ (#TagS "" "export")] tokens')) [true tokens'] _ [false tokens])) ?parts (: (Maybe (, Ident (List AST) (List AST))) (case tokens' - (\ (list& [_ (#FormS (list& [_ (#SymbolS name)] args))] sigs)) + (\ (@list& [_ (#FormS (@list& [_ (#SymbolS name)] args))] sigs)) (#Some name args sigs) - (\ (list& [_ (#SymbolS name)] sigs)) + (\ (@list& [_ (#SymbolS name)] sigs)) (#Some name #Nil sigs) _ @@ -2113,7 +2113,7 @@ (: (-> AST (Lux (, Text AST))) (lambda [token] (case token - (\ [_ (#FormS (list [_ (#SymbolS _ "_lux_:")] type [_ (#SymbolS ["" name])]))]) + (\ [_ (#FormS (@list [_ (#SymbolS _ "_lux_:")] type [_ (#SymbolS ["" name])]))]) (wrap (: (, Text AST) [name type])) _ @@ -2132,11 +2132,11 @@ _ (` (#NamedT [(~ (text$ _module)) (~ (text$ _name))] (;All (~ def-name) [(~@ args)] (~ sig-type))))))]] - (return (list& (` (;_lux_def (~ def-name) (~ sig+))) - sig-decl - (if export? - (list (` (;_lux_export (~ def-name)))) - #Nil)))) + (return (@list& (` (;_lux_def (~ def-name) (~ sig+))) + sig-decl + (if export? + (@list (` (;_lux_export (~ def-name)))) + #Nil)))) #None (fail "Wrong syntax for defsig")))) @@ -2297,7 +2297,7 @@ (-> Type Type (Maybe Type)) (case type-fn (#UnivQ env body) - (#Some (beta-reduce (list& type-fn param env) body)) + (#Some (beta-reduce (@list& type-fn param env) body)) (#AppT F A) (do Maybe/Monad @@ -2418,7 +2418,7 @@ (: (-> AST (Lux (, AST AST))) (lambda [token] (case token - (\ [_ (#FormS (list [_ (#SymbolS _ "_lux_def")] [_ (#SymbolS "" tag-name)] value))]) + (\ [_ (#FormS (@list [_ (#SymbolS _ "_lux_def")] [_ (#SymbolS "" tag-name)] value))]) (case (get tag-name tag-mappings) (#Some tag) (wrap (: (, AST AST) [tag value])) @@ -2429,22 +2429,22 @@ _ (fail (text:++ "Invalid structure member: " (ast:show token)))))) (list:join tokens'))] - (wrap (list (record$ members))))) + (wrap (@list (record$ members))))) (defmacro #export (defstruct tokens) (let [[export? tokens'] (: (, Bool (List AST)) (case tokens - (\ (list& [_ (#TagS "" "export")] tokens')) + (\ (@list& [_ (#TagS "" "export")] tokens')) [true tokens'] _ [false tokens])) ?parts (: (Maybe (, AST (List AST) AST (List AST))) (case tokens' - (\ (list& [_ (#FormS (list& name args))] type defs)) + (\ (@list& [_ (#FormS (@list& name args))] type defs)) (#Some name args type defs) - (\ (list& name type defs)) + (\ (@list& name type defs)) (#Some name #Nil type defs) _ @@ -2458,10 +2458,10 @@ _ (` (lambda (~ name) [(~@ args)] (;struct (~@ defs))))))] - (return (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 defstruct")))) @@ -2473,11 +2473,11 @@ (do-template [<name> <form> <message>] [(defmacro #export (<name> tokens) (case (reverse tokens) - (\ (list& last init)) - (return (list (foldL (: (-> AST AST AST) - (lambda [post pre] (` <form>))) - last - init))) + (\ (@list& last init)) + (return (@list (foldL (: (-> AST AST AST) + (lambda [post pre] (` <form>))) + last + init))) _ (fail <message>)))] @@ -2494,7 +2494,7 @@ (deftype Openings (, Text (List Ident))) -(deftype Import +(deftype Importation (, Text (Maybe Text) Referrals (Maybe Openings))) (def (extract-defs defs) @@ -2513,7 +2513,7 @@ (def (parse-alias tokens) (-> (List AST) (Lux (, (Maybe Text) (List AST)))) (case tokens - (\ (list& [_ (#TagS "" "as")] [_ (#SymbolS "" alias)] tokens')) + (\ (@list& [_ (#TagS "" "as")] [_ (#SymbolS "" alias)] tokens')) (return (: (, (Maybe Text) (List AST)) [(#Some alias) tokens'])) _ @@ -2522,17 +2522,17 @@ (def (parse-referrals tokens) (-> (List AST) (Lux (, Referrals (List AST)))) (case tokens - (\ (list& [_ (#TagS "" "refer")] referral tokens')) + (\ (@list& [_ (#TagS "" "refer")] referral tokens')) (case referral [_ (#TagS "" "all")] (return (: (, Referrals (List AST)) [#All tokens'])) - (\ [_ (#FormS (list& [_ (#TagS "" "only")] defs))]) + (\ [_ (#FormS (@list& [_ (#TagS "" "only")] defs))]) (do Lux/Monad [defs' (extract-defs defs)] (return (: (, Referrals (List AST)) [(#Only defs') tokens']))) - (\ [_ (#FormS (list& [_ (#TagS "" "exclude")] defs))]) + (\ [_ (#FormS (@list& [_ (#TagS "" "exclude")] defs))]) (do Lux/Monad [defs' (extract-defs defs)] (return (: (, Referrals (List AST)) [(#Exclude defs') tokens']))) @@ -2555,7 +2555,7 @@ (def (parse-openings tokens) (-> (List AST) (Lux (, (Maybe Openings) (List AST)))) (case tokens - (\ (list& [_ (#TagS "" "open")] [_ (#FormS (list& [_ (#TextS prefix)] structs))] tokens')) + (\ (@list& [_ (#TagS "" "open")] [_ (#FormS (@list& [_ (#TextS prefix)] structs))] tokens')) (do Lux/Monad [structs' (map% Lux/Monad extract-symbol structs)] (return (: (, (Maybe Openings) (List AST)) [(#Some prefix structs') tokens']))) @@ -2572,24 +2572,24 @@ [_ (#SymbolS "" sub-name)] (return (symbol$ ["" ($ text:++ super-name "/" sub-name)])) - (\ [_ (#FormS (list& [_ (#SymbolS "" sub-name)] parts))]) - (return (form$ (list& (symbol$ ["" ($ text:++ super-name "/" sub-name)]) parts))) + (\ [_ (#FormS (@list& [_ (#SymbolS "" sub-name)] parts))]) + (return (form$ (@list& (symbol$ ["" ($ text:++ super-name "/" sub-name)]) parts))) _ (fail "Wrong import syntax.")))) tokens)) (def (parse-imports imports) - (-> (List AST) (Lux (List Import))) + (-> (List AST) (Lux (List Importation))) (do Lux/Monad [imports' (map% Lux/Monad - (: (-> AST (Lux (List Import))) + (: (-> AST (Lux (List Importation))) (lambda [token] (case token [_ (#SymbolS "" m-name)] - (wrap (list [m-name #None #All #None])) + (wrap (@list [m-name #None #All #None])) - (\ [_ (#FormS (list& [_ (#SymbolS "" m-name)] extra))]) + (\ [_ (#FormS (@list& [_ (#SymbolS "" m-name)] extra))]) (do Lux/Monad [alias+extra (parse-alias extra) #let [[alias extra] alias+extra] @@ -2601,7 +2601,7 @@ sub-imports (parse-imports extra)] (wrap (case (: (, Referrals (Maybe Text) (Maybe Openings)) [referral alias openings]) [#Nothing #None #None] sub-imports - _ (list& [m-name alias referral openings] sub-imports)))) + _ (@list& [m-name alias referral openings] sub-imports)))) _ (fail "Wrong syntax for import")))) @@ -2637,8 +2637,8 @@ (lambda [gdef] (let [[name [export? _]] gdef] (if export? - (list name) - (list))))) + (@list name) + (@list))))) (let [{#module-aliases _ #defs defs #imports _ #tags tags #types types} =module] defs))] (#Right state (list:join to-alias))) @@ -2656,7 +2656,7 @@ (#Cons x xs') (if (p x) - (split-with' p (list& x ys) xs') + (split-with' p (@list& x ys) xs') [ys xs]))) (def (split-with p xs) @@ -2670,8 +2670,8 @@ (do Lux/Monad [module-name get-module-name] (case (split-module module) - (\ (list& "." parts)) - (return (|> (list& module-name parts) (interpose "/") (foldL text:++ ""))) + (\ (@list& "." parts)) + (return (|> (@list& module-name parts) (interpose "/") (foldL text:++ ""))) parts (let [[ups parts'] (split-with (text:= "..") parts) @@ -2683,7 +2683,7 @@ (fail (text:++ "Can't clean module: " module)) (#Some top-module) - (return (|> (list& top-module parts') (interpose "/") (foldL text:++ "")))) + (return (|> (@list& top-module parts') (interpose "/") (foldL text:++ "")))) ))) )) @@ -2691,7 +2691,7 @@ (All [a] (-> (-> a Bool) (List a) (List a))) (case xs #;Nil - (list) + (@list) (#;Cons x xs') (if (p x) @@ -2812,13 +2812,13 @@ (#Cons x xs') (case ys (#Cons y ys') - (list& [x y] (zip2 xs' ys')) + (@list& [x y] (zip2 xs' ys')) _ - (list)) + (@list)) _ - (list))) + (@list))) (def (use-field [module name] type) (-> Ident Type (Lux (, AST AST))) @@ -2840,7 +2840,7 @@ (defmacro #export (using tokens) (case tokens - (\ (list struct body)) + (\ (@list struct body)) (case struct [_ (#SymbolS name)] (do Lux/Monad @@ -2853,17 +2853,17 @@ (lambda [[sname stype]] (use-field sname stype))) (zip2 tags members)) #let [pattern (record$ slots)]] - (return (list (` (;_lux_case (~ struct) (~ pattern) (~ body)))))) + (return (@list (` (;_lux_case (~ struct) (~ pattern) (~ body)))))) _ (fail "Can only \"use\" records."))) _ (let [dummy (symbol$ ["" ""])] - (return (list (` (;_lux_case (~ struct) - (~ dummy) - (;using (~ dummy) - (~ body)))))))) + (return (@list (` (;_lux_case (~ struct) + (~ dummy) + (;using (~ dummy) + (~ body)))))))) _ (fail "Wrong syntax for using"))) @@ -2878,13 +2878,13 @@ (if (i= 0 (i% (length tokens) 2)) (fail "cond requires an even number of arguments.") (case (reverse tokens) - (\ (list& else branches')) - (return (list (foldL (: (-> AST (, AST AST) AST) - (lambda [else branch] - (let [[right left] branch] - (` (if (~ left) (~ right) (~ else)))))) - else - (as-pairs branches')))) + (\ (@list& else branches')) + (return (@list (foldL (: (-> AST (, AST AST) AST) + (lambda [else branch] + (let [[right left] branch] + (` (if (~ left) (~ right) (~ else)))))) + else + (as-pairs branches')))) _ (fail "Wrong syntax for cond")))) @@ -2904,7 +2904,7 @@ (defmacro #export (get@ tokens) (case tokens - (\ (list [_ (#TagS slot')] record)) + (\ (@list [_ (#TagS slot')] record)) (do Lux/Monad [slot (normalize slot') output (resolve-tag slot) @@ -2919,7 +2919,7 @@ g!output g!_)])) (zip2 tags (enumerate members))))] - (return (list (` (;_lux_case (~ record) (~ pattern) (~ g!output)))))) + (return (@list (` (;_lux_case (~ record) (~ pattern) (~ g!output)))))) _ (fail "get@ can only use records."))) @@ -2942,15 +2942,15 @@ (return (list:join decls'))) _ - (return (list (` (;_lux_def (~ (symbol$ ["" (text:++ prefix name)])) (~ source+)))))))) + (return (@list (` (;_lux_def (~ (symbol$ ["" (text:++ prefix name)])) (~ source+)))))))) (defmacro #export (open tokens) (case tokens - (\ (list& [_ (#SymbolS struct-name)] tokens')) + (\ (@list& [_ (#SymbolS struct-name)] tokens')) (do Lux/Monad [@module get-module-name #let [prefix (case tokens' - (\ (list [_ (#TextS prefix)])) + (\ (@list [_ (#TextS prefix)])) prefix _ @@ -2976,31 +2976,31 @@ (do Lux/Monad [imports (parse-imports tokens) imports (map% Lux/Monad - (: (-> Import (Lux Import)) + (: (-> Importation (Lux Importation)) (lambda [import] (case import [m-name m-alias m-referrals m-openings] (do Lux/Monad [m-name (clean-module m-name)] - (wrap (: Import [m-name m-alias m-referrals m-openings])))))) + (wrap (: Importation [m-name m-alias m-referrals m-openings])))))) imports) unknowns' (map% Lux/Monad - (: (-> Import (Lux (List Text))) + (: (-> Importation (Lux (List Text))) (lambda [import] (case import [m-name _ _ _] (do Lux/Monad [? (module-exists? m-name)] (wrap (if ? - (list) - (list m-name))))))) + (@list) + (@list m-name))))))) imports) #let [unknowns (list:join unknowns')]] (case unknowns #Nil (do Lux/Monad [output' (map% Lux/Monad - (: (-> Import (Lux (List AST))) + (: (-> Importation (Lux (List AST))) (lambda [import] (case import [m-name m-alias m-referrals m-openings] @@ -3020,11 +3020,11 @@ (wrap (filter (. not (is-member? -defs)) *defs))) #Nothing - (wrap (list))) + (wrap (@list))) #let [openings (: (List AST) (case m-openings #None - (list) + (@list) (#Some prefix structs) (map (: (-> Ident AST) @@ -3033,11 +3033,11 @@ (` (open (~ (symbol$ [m-name name])) (~ (text$ prefix))))))) structs)))]] (wrap ($ list:++ - (: (List AST) (list (` (;_lux_import (~ (text$ m-name)))))) + (: (List AST) (@list (` (;_lux_import (~ (text$ m-name)))))) (: (List AST) (case m-alias - #None (list) - (#Some alias) (list (` (;_lux_alias (~ (text$ alias)) (~ (text$ m-name))))))) + #None (@list) + (#Some alias) (@list (` (;_lux_alias (~ (text$ alias)) (~ (text$ m-name))))))) (map (: (-> Text AST) (lambda [def] (` (;_lux_def (~ (symbol$ ["" def])) (~ (symbol$ [m-name def])))))) @@ -3049,7 +3049,7 @@ _ (wrap (list:++ (map (: (-> Text AST) (lambda [m-name] (` (;_lux_import (~ (text$ m-name)))))) unknowns) - (: (List AST) (list (` (;import (~@ tokens)))))))))) + (: (List AST) (@list (` (;import (~@ tokens)))))))))) (def (foldL% M f x ys) (All [m a b] @@ -3066,7 +3066,7 @@ (defmacro #export (:: tokens) (case tokens - (\ (list& start parts)) + (\ (@list& start parts)) (do Lux/Monad [output (foldL% Lux/Monad (: (-> AST AST (Lux AST)) @@ -3075,21 +3075,21 @@ [_ (#SymbolS slot)] (return (: AST (` (get@ (~ (tag$ slot)) (~ so-far))))) - (\ [_ (#FormS (list& [_ (#SymbolS slot)] args))]) + (\ [_ (#FormS (@list& [_ (#SymbolS slot)] args))]) (return (: AST (` ((get@ (~ (tag$ slot)) (~ so-far)) (~@ args))))) _ (fail "Wrong syntax for ::")))) start parts)] - (return (list output))) + (return (@list output))) _ (fail "Wrong syntax for ::"))) (defmacro #export (set@ tokens) (case tokens - (\ (list [_ (#TagS slot')] value record)) + (\ (@list [_ (#TagS slot')] value record)) (do Lux/Monad [slot (normalize slot') output (resolve-tag slot) @@ -3114,7 +3114,7 @@ value r-var)])) pattern'))] - (return (list (` (;_lux_case (~ record) (~ pattern) (~ output))))))) + (return (@list (` (;_lux_case (~ record) (~ pattern) (~ output))))))) _ (fail "set@ can only use records."))) @@ -3124,7 +3124,7 @@ (defmacro #export (update@ tokens) (case tokens - (\ (list [_ (#TagS slot')] fun record)) + (\ (@list [_ (#TagS slot')] fun record)) (do Lux/Monad [slot (normalize slot') output (resolve-tag slot) @@ -3149,7 +3149,7 @@ (` ((~ fun) (~ r-var))) r-var)])) pattern'))] - (return (list (` (;_lux_case (~ record) (~ pattern) (~ output))))))) + (return (@list (` (;_lux_case (~ record) (~ pattern) (~ output))))))) _ (fail "update@ can only use records."))) @@ -3159,9 +3159,9 @@ (defmacro #export (\template tokens) (case tokens - (\ (list [_ (#TupleS data)] - [_ (#TupleS bindings)] - [_ (#TupleS templates)])) + (\ (@list [_ (#TupleS data)] + [_ (#TupleS bindings)] + [_ (#TupleS templates)])) (case (: (Maybe (List AST)) (do Maybe/Monad [bindings' (map% Maybe/Monad get-name bindings) @@ -3192,7 +3192,7 @@ #Nil (#Cons y ys') - (list& x y (interleave xs' ys'))))) + (@list& x y (interleave xs' ys'))))) (do-template [<name> <init> <op>] [(def (<name> p xs) @@ -3253,7 +3253,7 @@ (return (list (` ((: (-> (~@ (map type->syntax init-types)) (~ (type->syntax expected))) (lambda (~ (symbol$ ["" "recur"])) [(~@ vars)] - (~ body))) + (~ body))) (~@ inits)))))) (do Lux/Monad [aliases (map% Lux/Monad @@ -3262,7 +3262,7 @@ inits)] (return (list (` (let [(~@ (interleave aliases inits))] (;loop [(~@ (interleave vars aliases))] - (~ body))))))))) + (~ body))))))))) _ (fail "Wrong syntax for loop"))) |