diff options
author | Eduardo Julian | 2015-08-31 12:35:50 -0400 |
---|---|---|
committer | Eduardo Julian | 2015-08-31 12:35:50 -0400 |
commit | 1857af8628216353c4fa0b75a921d66b266aa0b9 (patch) | |
tree | 6af36b174c90a19bc1d63f09dc5006ebaa4d10a2 /source/lux.lux | |
parent | a0533814cbc3b4b59850f97e9e72abc8bb83ff57 (diff) |
- Found a compromise with the issue of certain definitions clashing with each other when saving the class files in case-insensitive file-systems (https://github.com/LuxLang/lux/issues/8). The names of certain definitions were changed slightly to avoid clashes and the compiler throws an error if the names end up clashing prior to saving the .class file.
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"))) |