aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--source/lux.lux516
-rw-r--r--source/lux/codata/lazy.lux4
-rw-r--r--source/lux/codata/stream.lux12
-rw-r--r--source/lux/data/io.lux20
-rw-r--r--source/lux/data/list.lux16
-rw-r--r--source/lux/data/text.lux14
-rw-r--r--source/lux/host/jvm.lux116
-rw-r--r--source/lux/meta/lux.lux20
-rw-r--r--source/lux/meta/syntax.lux28
-rw-r--r--src/lux/compiler/base.clj9
10 files changed, 379 insertions, 376 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")))
diff --git a/source/lux/codata/lazy.lux b/source/lux/codata/lazy.lux
index fb0c0bcb3..542bb9922 100644
--- a/source/lux/codata/lazy.lux
+++ b/source/lux/codata/lazy.lux
@@ -19,9 +19,9 @@
## [Syntax]
(defmacro #export (... tokens state)
(case tokens
- (\ (list value))
+ (\ (@list value))
(let [blank (symbol$ ["" ""])]
- (#;Right [state (list (` (;lambda [(~ blank)] ((~ blank) (~ value)))))]))
+ (#;Right [state (@list (` (;lambda [(~ blank)] ((~ blank) (~ value)))))]))
_
(#;Left "Wrong syntax for ...")))
diff --git a/source/lux/codata/stream.lux b/source/lux/codata/stream.lux
index d0f84f0c7..a25a19b5f 100644
--- a/source/lux/codata/stream.lux
+++ b/source/lux/codata/stream.lux
@@ -10,7 +10,7 @@
(meta lux
macro
syntax)
- (data (list #as l #refer (#only list list& List/Monad))
+ (data (list #as l #refer (#only @list @list& List/Monad))
(number (int #open ("i" Int/Number Int/Ord)))
bool)
(codata (lazy #as L #refer #all))))
@@ -67,8 +67,8 @@
(-> <det-type> (Stream a) (List a)))
(let [[x xs'] (! xs)]
(if <det-test>
- (list& x (<taker> <det-step> xs'))
- (list))))
+ (@list& x (<taker> <det-step> xs'))
+ (@list))))
(def #export (<dropper> det xs)
(All [a]
@@ -85,7 +85,7 @@
(if <det-test>
(let [[tail next] (<splitter> <det-step> xs')]
[(#;Cons [x tail]) next])
- [(list) xs])))]
+ [(@list) xs])))]
[take-while drop-while split-with (-> a Bool) (det x) det]
[take drop split Int (i> det 0) (i+ -1 det)]
@@ -128,5 +128,5 @@
#let [patterns+ (: (List AST)
(do List/Monad
[pattern (l;reverse patterns)]
- (: (List AST) (list (` [(~ pattern) (~ g!s)]) (` (L;! (~ g!s)))))))]]
- (wrap (list g!s (` (;let [(~@ patterns+)] (~ body)))))))
+ (: (List AST) (@list (` [(~ pattern) (~ g!s)]) (` (L;! (~ g!s)))))))]]
+ (wrap (@list g!s (` (;let [(~@ patterns+)] (~ body)))))))
diff --git a/source/lux/data/io.lux b/source/lux/data/io.lux
index 1ca68f518..5c54c0369 100644
--- a/source/lux/data/io.lux
+++ b/source/lux/data/io.lux
@@ -16,25 +16,25 @@
(-> (,) a))
## [Syntax]
-(defmacro #export (io tokens state)
+(defmacro #export (@io tokens state)
(case tokens
- (\ (list value))
+ (\ (@list value))
(let [blank (symbol$ ["" ""])]
- (#;Right [state (list (` (;_lux_lambda (~ blank) (~ blank) (~ value))))]))
+ (#;Right [state (@list (` (;_lux_lambda (~ blank) (~ blank) (~ value))))]))
_
- (#;Left "Wrong syntax for io")))
+ (#;Left "Wrong syntax for @io")))
## [Structures]
(defstruct #export IO/Functor (F;Functor IO)
(def (map f ma)
- (io (f (ma [])))))
+ (@io (f (ma [])))))
(defstruct #export IO/Monad (M;Monad IO)
(def _functor IO/Functor)
(def (wrap x)
- (io x))
+ (@io x))
(def (join mma)
(mma [])))
@@ -42,10 +42,10 @@
## [Functions]
(def #export (print x)
(-> Text (IO (,)))
- (io (_jvm_invokevirtual "java.io.PrintStream" "print" ["java.lang.String"]
- (_jvm_getstatic "java.lang.System" "out") [x])))
+ (@io (_jvm_invokevirtual "java.io.PrintStream" "print" ["java.lang.String"]
+ (_jvm_getstatic "java.lang.System" "out") [x])))
(def #export (println x)
(-> Text (IO (,)))
- (io (_jvm_invokevirtual "java.io.PrintStream" "println" ["java.lang.String"]
- (_jvm_getstatic "java.lang.System" "out") [x])))
+ (@io (_jvm_invokevirtual "java.io.PrintStream" "println" ["java.lang.String"]
+ (_jvm_getstatic "java.lang.System" "out") [x])))
diff --git a/source/lux/data/list.lux b/source/lux/data/list.lux
index 7df2eb358..489ac5b4f 100644
--- a/source/lux/data/list.lux
+++ b/source/lux/data/list.lux
@@ -213,23 +213,23 @@
(@ (i+ -1 i) xs'))))
## [Syntax]
-(defmacro #export (list xs state)
+(defmacro #export (@list xs state)
(#;Right state (#;Cons (foldL (: (-> AST AST AST)
(lambda [tail head] (` (#;Cons (~ head) (~ tail)))))
(: AST (` #;Nil))
(reverse xs))
#;Nil)))
-(defmacro #export (list& xs state)
+(defmacro #export (@list& xs state)
(case (reverse xs)
(#;Cons last init)
- (#;Right state (list (foldL (: (-> AST AST AST)
+ (#;Right state (@list (foldL (: (-> AST AST AST)
(lambda [tail head] (` (#;Cons (~ head) (~ tail)))))
last
init)))
_
- (#;Left "Wrong syntax for list&")))
+ (#;Left "Wrong syntax for @list&")))
## [Structures]
## (defstruct #export (List/Eq eq) (All [a] (-> (Eq a) (Eq (List a))))
@@ -257,14 +257,14 @@
(defstruct #export List/Functor (Functor List)
(def (map f ma)
(case ma
- #;Nil #;Nil
- (#;Cons [a ma']) (#;Cons [(f a) (map f ma')]))))
+ #;Nil #;Nil
+ (#;Cons a ma') (#;Cons (f a) (map f ma')))))
(defstruct #export List/Monad (Monad List)
(def _functor List/Functor)
(def (wrap a)
- (#;Cons [a #;Nil]))
+ (#;Cons a #;Nil))
(def (join mma)
(using List/Monoid
@@ -282,4 +282,4 @@
(let [pre (filter (>= x) xs')
post (filter (< x) xs')
++ (:: List/Monoid m;++)]
- ($ ++ (sort ord pre) (list x) (sort ord post))))))
+ ($ ++ (sort ord pre) (@list x) (sort ord post))))))
diff --git a/source/lux/data/text.lux b/source/lux/data/text.lux
index 533308dd0..e54dff5c0 100644
--- a/source/lux/data/text.lux
+++ b/source/lux/data/text.lux
@@ -13,7 +13,7 @@
(monad #as M #refer #all))
(data (number (int #open ("i" Int/Number Int/Ord)))
maybe
- (list #refer (#only foldL list list&)))))
+ (list #refer (#only foldL @list @list&)))))
## [Functions]
(def #export (size x)
@@ -158,18 +158,18 @@
(-> Text (List AST))
(case (extract-var template)
(#;Some [pre var post])
- (list& (text$ pre) (symbol$ ["" var])
- (unravel-template post))
+ (@list& (text$ pre) (symbol$ ["" var])
+ (unravel-template post))
#;None
- (list (text$ template))))
+ (@list (text$ template))))
(defmacro #export (<> tokens state)
(case tokens
- (\ (list [_ (#;TextS template)]))
+ (\ (@list [_ (#;TextS template)]))
(let [++ (symbol$ ["" ""])]
- (#;Right state (list (` (;let [(~ ++) (;:: Text/Monoid m;++)]
- (;$ (~ ++) (~@ (unravel-template template))))))))
+ (#;Right state (@list (` (;let [(~ ++) (;:: Text/Monoid m;++)]
+ (;$ (~ ++) (~@ (unravel-template template))))))))
_
(#;Left "Wrong syntax for <>")))
diff --git a/source/lux/host/jvm.lux b/source/lux/host/jvm.lux
index d7992509a..7a564826c 100644
--- a/source/lux/host/jvm.lux
+++ b/source/lux/host/jvm.lux
@@ -82,21 +82,21 @@
## [Syntax]
(defsyntax #export (throw ex)
- (emit (list (` (;_jvm_throw (~ ex))))))
+ (emit (@list (` (;_jvm_throw (~ ex))))))
(defsyntax #export (try body [catches (*^ catch^)] [finally (?^ finally^)])
- (emit (list (` (;_jvm_try (~ body)
- (~@ (:: List/Monoid (m;++ (map (: (-> (, Text Ident AST) AST)
- (lambda [catch]
- (let [[class ex body] catch]
- (` (;_jvm_catch (~ (text$ class)) (~ (symbol$ ex)) (~ body))))))
- catches)
- (case finally
- #;None
- (list)
-
- (#;Some finally)
- (: (List AST) (list (` (;_jvm_finally (~ finally))))))))))))))
+ (emit (@list (` (;_jvm_try (~ body)
+ (~@ (:: List/Monoid (m;++ (map (: (-> (, Text Ident AST) AST)
+ (lambda [catch]
+ (let [[class ex body] catch]
+ (` (;_jvm_catch (~ (text$ class)) (~ (symbol$ ex)) (~ body))))))
+ catches)
+ (case finally
+ #;None
+ (@list)
+
+ (#;Some finally)
+ (: (List AST) (@list (` (;_jvm_finally (~ finally))))))))))))))
(defsyntax #export (definterface [name local-symbol^] [supers (tuple^ (*^ local-symbol^))] [members (*^ method-decl^)])
(let [members' (map (: (-> (, (List Text) Text (List Text) Text) AST)
@@ -104,8 +104,8 @@
(let [[modifiers name inputs output] member]
(` ((~ (text$ name)) [(~@ (map text$ inputs))] (~ (text$ output)) [(~@ (map text$ modifiers))])))))
members)]
- (emit (list (` (;_jvm_interface (~ (text$ name)) [(~@ (map text$ supers))]
- (~@ members')))))))
+ (emit (@list (` (;_jvm_interface (~ (text$ name)) [(~@ (map text$ supers))]
+ (~@ members')))))))
(defsyntax #export (defclass [name local-symbol^] [super local-symbol^] [interfaces (tuple^ (*^ local-symbol^))]
[fields (*^ field-decl^)]
@@ -126,44 +126,44 @@
[(~@ (map (: (-> (, Text Text) AST)
(lambda [in]
(let [[left right] in]
- (form$ (list (symbol$ ["" left])
- (text$ right))))))
+ (form$ (@list (symbol$ ["" left])
+ (text$ right))))))
inputs))]
(~ (text$ output))
[(~@ (map text$ modifiers))]
(~ body))))))
methods)]]
- (emit (list (` (;_jvm_class (~ (text$ name)) (~ (text$ super))
- [(~@ (map text$ interfaces))]
- [(~@ fields')]
- [(~@ methods')]))))))
+ (emit (@list (` (;_jvm_class (~ (text$ name)) (~ (text$ super))
+ [(~@ (map text$ interfaces))]
+ [(~@ fields')]
+ [(~@ methods')]))))))
(defsyntax #export (new [class local-symbol^] [arg-classes (tuple^ (*^ local-symbol^))] [args (tuple^ (*^ id^))])
- (emit (list (` (;_jvm_new (~ (text$ class))
- [(~@ (map text$ arg-classes))]
- [(~@ args)])))))
+ (emit (@list (` (;_jvm_new (~ (text$ class))
+ [(~@ (map text$ arg-classes))]
+ [(~@ args)])))))
(defsyntax #export (instance? [class local-symbol^] obj)
- (emit (list (` (;_jvm_instanceof (~ (text$ class)) (~ obj))))))
+ (emit (@list (` (;_jvm_instanceof (~ (text$ class)) (~ obj))))))
(defsyntax #export (locking lock body)
(do Lux/Monad
[g!lock (gensym "")
g!body (gensym "")
g!_ (gensym "")]
- (emit (list (` (let [(~ g!lock) (~ lock)
- (~ g!_) (;_jvm_monitorenter (~ g!lock))
- (~ g!body) (~ body)
- (~ g!_) (;_jvm_monitorexit (~ g!lock))]
- (~ g!body)))))
+ (emit (@list (` (let [(~ g!lock) (~ lock)
+ (~ g!_) (;_jvm_monitorenter (~ g!lock))
+ (~ g!body) (~ body)
+ (~ g!_) (;_jvm_monitorexit (~ g!lock))]
+ (~ g!body)))))
))
(defsyntax #export (null? obj)
- (emit (list (` (;_jvm_null? (~ obj))))))
+ (emit (@list (` (;_jvm_null? (~ obj))))))
(defsyntax #export (program [args symbol^] body)
- (emit (list (` (;_jvm_program (~ (symbol$ args))
- (~ body))))))
+ (emit (@list (` (;_jvm_program (~ (symbol$ args))
+ (~ body))))))
(defsyntax #export (.? [field local-symbol^] obj)
(case obj
@@ -172,7 +172,7 @@
[obj-type (find-var-type obj-name)]
(case obj-type
(#;DataT class)
- (emit (list (` (;_jvm_getfield (~ (text$ class)) (~ (text$ field))))))
+ (emit (@list (` (;_jvm_getfield (~ (text$ class)) (~ (text$ field))))))
_
(fail "Can only get field from object.")))
@@ -180,8 +180,8 @@
_
(do Lux/Monad
[g!obj (gensym "")]
- (emit (list (` (let [(~ g!obj) (~ obj)]
- (;;.? (~ (text$ field)) (~ g!obj)))))))))
+ (emit (@list (` (let [(~ g!obj) (~ obj)]
+ (;;.? (~ (text$ field)) (~ g!obj)))))))))
(defsyntax #export (.= [field local-symbol^] value obj)
(case obj
@@ -190,7 +190,7 @@
[obj-type (find-var-type obj-name)]
(case obj-type
(#;DataT class)
- (emit (list (` (;_jvm_putfield (~ (text$ class)) (~ (text$ field)) (~ value)))))
+ (emit (@list (` (;_jvm_putfield (~ (text$ class)) (~ (text$ field)) (~ value)))))
_
(fail "Can only set field of object.")))
@@ -198,8 +198,8 @@
_
(do Lux/Monad
[g!obj (gensym "")]
- (emit (list (` (let [(~ g!obj) (~ obj)]
- (;;.= (~ (text$ field)) (~ value) (~ g!obj)))))))))
+ (emit (@list (` (let [(~ g!obj) (~ obj)]
+ (;;.= (~ (text$ field)) (~ value) (~ g!obj)))))))))
(defsyntax #export (.! [call method-call^] obj)
(let [[m-name ?m-classes m-args] call]
@@ -209,8 +209,8 @@
[obj-type (find-var-type obj-name)]
(case obj-type
(#;DataT class)
- (emit (list (` (;_jvm_invokevirtual (~ (text$ class)) (~ (text$ m-name)) [(~@ (map text$ ?m-classes))]
- (~ obj) [(~@ m-args)]))))
+ (emit (@list (` (;_jvm_invokevirtual (~ (text$ class)) (~ (text$ m-name)) [(~@ (map text$ ?m-classes))]
+ (~ obj) [(~@ m-args)]))))
_
(fail "Can only call method on object.")))
@@ -218,33 +218,33 @@
_
(do Lux/Monad
[g!obj (gensym "")]
- (emit (list (` (let [(~ g!obj) (~ obj)]
- (;;.! ((~ (symbol$ ["" m-name]))
- [(~@ (map (lambda [c] (symbol$ ["" c])) ?m-classes))]
- [(~@ m-args)])
- (~ g!obj))))))))))
+ (emit (@list (` (let [(~ g!obj) (~ obj)]
+ (;;.! ((~ (symbol$ ["" m-name]))
+ [(~@ (map (lambda [c] (symbol$ ["" c])) ?m-classes))]
+ [(~@ m-args)])
+ (~ g!obj))))))))))
(defsyntax #export (..? [field local-symbol^] [class local-symbol^])
- (emit (list (` (;_jvm_getstatic (~ (text$ class)) (~ (text$ field)))))))
+ (emit (@list (` (;_jvm_getstatic (~ (text$ class)) (~ (text$ field)))))))
(defsyntax #export (..= [field local-symbol^] value [class local-symbol^])
- (emit (list (` (;_jvm_putstatic (~ (text$ class)) (~ (text$ field)) (~ value))))))
+ (emit (@list (` (;_jvm_putstatic (~ (text$ class)) (~ (text$ field)) (~ value))))))
(defsyntax #export (..! [call method-call^] [class local-symbol^])
(let [[m-name m-classes m-args] call]
- (emit (list (` (;_jvm_invokestatic (~ (text$ class)) (~ (text$ m-name))
- [(~@ (map text$ m-classes))]
- [(~@ m-args)]))))))
+ (emit (@list (` (;_jvm_invokestatic (~ (text$ class)) (~ (text$ m-name))
+ [(~@ (map text$ m-classes))]
+ [(~@ m-args)]))))))
(defsyntax #export (->maybe expr)
(do Lux/Monad
[g!val (gensym "")]
- (emit (list (` (let [(~ g!val) (~ expr)]
- (if (null? (~ g!val))
- #;None
- (#;Some (~ g!val)))))))))
+ (emit (@list (` (let [(~ g!val) (~ expr)]
+ (if (null? (~ g!val))
+ #;None
+ (#;Some (~ g!val)))))))))
(defsyntax #export (try$ expr)
- (emit (list (` (try (#;Right (~ expr))
- (~ (' (catch java.lang.Exception e
- (#;Left (.! (getMessage [] []) e))))))))))
+ (emit (@list (` (try (#;Right (~ expr))
+ (~ (' (catch java.lang.Exception e
+ (#;Left (.! (getMessage [] []) e))))))))))
diff --git a/source/lux/meta/lux.lux b/source/lux/meta/lux.lux
index 32ca78570..df3ebae48 100644
--- a/source/lux/meta/lux.lux
+++ b/source/lux/meta/lux.lux
@@ -131,10 +131,10 @@
(wrap (:: List/Monad (M;join expansion'))))
#;None
- (:: Lux/Monad (M;wrap (list syntax)))))
+ (:: Lux/Monad (M;wrap (@list syntax)))))
_
- (:: Lux/Monad (M;wrap (list syntax)))))
+ (:: Lux/Monad (M;wrap (@list syntax)))))
(def #export (macro-expand-all syntax)
(-> AST (Lux (List AST)))
@@ -152,22 +152,22 @@
#;None
(do Lux/Monad
- [parts' (M;map% Lux/Monad macro-expand-all (list& (symbol$ macro-name) args))]
- (wrap (list (form$ (:: List/Monad (M;join parts'))))))))
+ [parts' (M;map% Lux/Monad macro-expand-all (@list& (symbol$ macro-name) args))]
+ (wrap (@list (form$ (:: List/Monad (M;join parts'))))))))
[_ (#;FormS (#;Cons [harg targs]))]
(do Lux/Monad
[harg+ (macro-expand-all harg)
targs+ (M;map% Lux/Monad macro-expand-all targs)]
- (wrap (list (form$ (list:++ harg+ (:: List/Monad (M;join (: (List (List AST)) targs+))))))))
+ (wrap (@list (form$ (list:++ harg+ (:: List/Monad (M;join (: (List (List AST)) targs+))))))))
[_ (#;TupleS members)]
(do Lux/Monad
[members' (M;map% Lux/Monad macro-expand-all members)]
- (wrap (list (tuple$ (:: List/Monad (M;join members'))))))
+ (wrap (@list (tuple$ (:: List/Monad (M;join members'))))))
_
- (:: Lux/Monad (M;wrap (list syntax)))))
+ (:: Lux/Monad (M;wrap (@list syntax)))))
(def #export (gensym prefix state)
(-> Text (Lux AST))
@@ -191,7 +191,7 @@
(do Lux/Monad
[token+ (macro-expand token)]
(case token+
- (\ (list token'))
+ (\ (@list token'))
(wrap token')
_
@@ -216,8 +216,8 @@
(lambda [gdef]
(let [[name [export? _]] gdef]
(if export?
- (list name)
- (list)))))
+ (@list name)
+ (@list)))))
(get@ #;defs =module)))]))
#;None
diff --git a/source/lux/meta/syntax.lux b/source/lux/meta/syntax.lux
index df79772c1..3bc3196e2 100644
--- a/source/lux/meta/syntax.lux
+++ b/source/lux/meta/syntax.lux
@@ -27,7 +27,7 @@
(All [a] (-> (List (, a a)) (List a)))
(case pairs
#;Nil #;Nil
- (#;Cons [[x y] pairs']) (list& x y (join-pairs pairs'))))
+ (#;Cons [[x y] pairs']) (@list& x y (join-pairs pairs'))))
## [Types]
(deftype #export (Parser a)
@@ -160,10 +160,10 @@
(All [a]
(-> (Parser a) (Parser (List a))))
(case (p tokens)
- #;None (#;Some [tokens (list)])
+ #;None (#;Some [tokens (@list)])
(#;Some [tokens' x]) (run-parser (do Parser/Monad
[xs (*^ p)]
- (wrap (list& x xs)))
+ (wrap (@list& x xs)))
tokens')))
(def #export (+^ p)
@@ -172,7 +172,7 @@
(do Parser/Monad
[x p
xs (*^ p)]
- (wrap (list& x xs))))
+ (wrap (@list& x xs))))
(def #export (&^ p1 p2)
(All [a b]
@@ -212,21 +212,21 @@
(defmacro #export (defsyntax tokens)
(let [[exported? tokens] (: (, Bool (List AST))
(case tokens
- (\ (list& [_ (#;TagS ["" "export"])] tokens'))
+ (\ (@list& [_ (#;TagS ["" "export"])] tokens'))
[true tokens']
_
[false tokens]))]
(case tokens
- (\ (list [_ (#;FormS (list& [_ (#;SymbolS ["" name])] args))]
- body))
+ (\ (@list [_ (#;FormS (@list& [_ (#;SymbolS ["" name])] args))]
+ body))
(do Lux/Monad
[names+parsers (M;map% Lux/Monad
(: (-> AST (Lux (, AST AST)))
(lambda [arg]
(case arg
- (\ [_ (#;TupleS (list [_ (#;SymbolS var-name)]
- parser))])
+ (\ [_ (#;TupleS (@list [_ (#;SymbolS var-name)]
+ parser))])
(wrap [(symbol$ var-name) parser])
(\ [_ (#;SymbolS var-name)])
@@ -249,14 +249,14 @@
(~ g!_)
(l;fail (~ error-msg)))))))
body
- (: (List (, AST AST)) (list& [(symbol$ ["" ""]) (` end^)] (reverse names+parsers))))
+ (: (List (, AST AST)) (@list& [(symbol$ ["" ""]) (` end^)] (reverse names+parsers))))
macro-def (: AST
(` (defmacro ((~ (symbol$ ["" name])) (~ g!tokens))
(~ body'))))]]
- (wrap (list& macro-def
- (if exported?
- (list (` (;_lux_export (~ (symbol$ ["" name])))))
- (list)))))
+ (wrap (@list& macro-def
+ (if exported?
+ (@list (` (;_lux_export (~ (symbol$ ["" name])))))
+ (@list)))))
_
(l;fail "Wrong syntax for defsyntax"))))
diff --git a/src/lux/compiler/base.clj b/src/lux/compiler/base.clj
index b6efaada8..edb1441ca 100644
--- a/src/lux/compiler/base.clj
+++ b/src/lux/compiler/base.clj
@@ -46,9 +46,12 @@
(def tag-group-separator "\n")
;; [Utils]
-(defn ^:private write-file [^String file ^bytes data]
- (with-open [stream (BufferedOutputStream. (FileOutputStream. file))]
- (.write stream data)))
+(defn ^:private write-file [^String file-name ^bytes data]
+ (let [;; file-name (.toLowerCase file-name)
+ ]
+ (do (assert (not (.exists (File. file-name))) (str "Can't overwrite file: " file-name))
+ (with-open [stream (BufferedOutputStream. (FileOutputStream. file-name))]
+ (.write stream data)))))
(defn ^:private write-output [module name data]
(let [module* (&host/->module-class module)
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-27 10:45:14 +0000