aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEduardo Julian2018-07-07 06:58:36 -0400
committerEduardo Julian2018-07-07 06:58:36 -0400
commit758ed85b01de0a655ac4f91c3682111de220031d (patch)
treecd11d22c5215051d108ff9a181e375ae8e20cc3a
parent1b5cb7ab5ff0b774f0cd12f9504b82dae9ae977d (diff)
- Improved syntax for pattern-matching.
Diffstat (limited to '')
-rw-r--r--luxc/src/lux/analyser.clj10
-rw-r--r--stdlib/source/lux.lux830
-rw-r--r--stdlib/source/lux/control/comonad.lux10
-rw-r--r--stdlib/source/lux/control/monad.lux10
-rw-r--r--stdlib/source/lux/host.jvm.lux6
-rw-r--r--stdlib/source/lux/macro/syntax.lux18
6 files changed, 435 insertions, 449 deletions
diff --git a/luxc/src/lux/analyser.clj b/luxc/src/lux/analyser.clj
index 56cb8a375..0cc908e0e 100644
--- a/luxc/src/lux/analyser.clj
+++ b/luxc/src/lux/analyser.clj
@@ -141,11 +141,6 @@
(&/with-cursor cursor
(&&lux/analyse-program analyse optimize compile-program ?program)))
- "lux case"
- (|let [(&/$Cons ?value (&/$Cons [_ (&/$Record ?branches)] (&/$Nil))) parameters]
- (&/with-analysis-meta cursor exo-type
- (&&lux/analyse-case analyse exo-type ?value ?branches)))
-
"lux function"
(|let [(&/$Cons [_ (&/$Symbol "" ?self)]
(&/$Cons [_ (&/$Symbol "" ?arg)]
@@ -182,6 +177,11 @@
(&/with-analysis-meta cursor exo-type
(analyse-variant+ analyse exo-type ?ident parameters))
+ (&/$Record ?pattern-matching)
+ (|let [(&/$Cons ?input (&/$Nil)) parameters]
+ (&/with-analysis-meta cursor exo-type
+ (&&lux/analyse-case analyse exo-type ?input ?pattern-matching)))
+
_
(&/with-cursor cursor
(|do [=fn (just-analyse analyse (&/T [command-meta command]))]
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index 5a484598e..5f7019b16 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -206,12 +206,9 @@
## )
("lux def" Type
(+10 ["lux" "Type"]
- ("lux case" ("lux check type" (+9 (+4 +1) (+4 +0)))
- {Type
- ("lux case" ("lux check type" (+9 Type List))
- {Type-List
- ("lux case" ("lux check type" (+2 Type Type))
- {Type-Pair
+ ({Type
+ ({Type-List
+ ({Type-Pair
(+9 Nothing
(+7 #Nil
(+1 ## "lux.Primitive"
@@ -235,7 +232,10 @@
(+1 ## "lux.Apply"
Type-Pair
## "lux.Named"
- (+2 Ident Type)))))))))))))})})}))
+ (+2 Ident Type)))))))))))))}
+ ("lux check type" (+2 Type Type)))}
+ ("lux check type" (+9 Type List)))}
+ ("lux check type" (+9 (+4 +1) (+4 +0)))))
[dummy-cursor
(+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])]
[dummy-cursor (+0 true)]]
@@ -319,12 +319,8 @@
## (#Record (List [(w (Code' w)) (w (Code' w))])))
("lux def" Code'
(#Named ["lux" "Code'"]
- ("lux case" ("lux check type" (#Apply (#Apply (#Parameter +1)
- (#Parameter +0))
- (#Parameter +1)))
- {Code
- ("lux case" ("lux check type" (#Apply Code List))
- {Code-List
+ ({Code
+ ({Code-List
(#UnivQ #Nil
(#Sum ## "lux.Bool"
Bool
@@ -349,7 +345,11 @@
## "lux.Record"
(#Apply (#Product Code Code) List)
))))))))))
- )})}))
+ )}
+ ("lux check type" (#Apply Code List)))}
+ ("lux check type" (#Apply (#Apply (#Parameter +1)
+ (#Parameter +0))
+ (#Parameter +1)))))
[dummy-cursor
(+10 (#Cons [[dummy-cursor (+7 ["lux" "tags"])]
[dummy-cursor (+9 (#Cons [dummy-cursor (+5 "Bool")]
@@ -376,9 +376,9 @@
## (Ann Cursor (Code' (Ann Cursor))))
("lux def" Code
(#Named ["lux" "Code"]
- ("lux case" ("lux check type" (#Apply Cursor Ann))
- {w
- (#Apply (#Apply w Code') w)}))
+ ({w
+ (#Apply (#Apply w Code') w)}
+ ("lux check type" (#Apply Cursor Ann))))
[dummy-cursor
(#Record (#Cons [[dummy-cursor (#Tag ["lux" "doc"])]
[dummy-cursor (#Text "The type of Code nodes for Lux syntax.")]]
@@ -810,32 +810,30 @@
("lux def" let''
("lux check" Macro
("lux function" _ tokens
- ("lux case" tokens
- {(#Cons lhs (#Cons rhs (#Cons body #Nil)))
- (return (#Cons (form$ (#Cons (text$ "lux case")
- (#Cons rhs (#Cons (record$ (#Cons [lhs body] #Nil)) #Nil))))
+ ({(#Cons lhs (#Cons rhs (#Cons body #Nil)))
+ (return (#Cons (form$ (#Cons (record$ (#Cons [lhs body] #Nil)) (#Cons rhs #Nil)))
#Nil))
_
- (fail "Wrong syntax for let''")})))
+ (fail "Wrong syntax for let''")}
+ tokens)))
(record$ default-macro-meta))
("lux def" function''
("lux check" Macro
("lux function" _ tokens
- ("lux case" tokens
- {(#Cons [_ (#Tuple (#Cons arg args'))] (#Cons body #Nil))
+ ({(#Cons [_ (#Tuple (#Cons arg args'))] (#Cons body #Nil))
(return (#Cons (_ann (#Form (#Cons (_ann (#Text "lux function"))
(#Cons (_ann (#Symbol "" ""))
(#Cons arg
- (#Cons ("lux case" args'
- {#Nil
+ (#Cons ({#Nil
body
_
(_ann (#Form (#Cons (_ann (#Symbol "lux" "function''"))
(#Cons (_ann (#Tuple args'))
- (#Cons body #Nil)))))})
+ (#Cons body #Nil)))))}
+ args')
#Nil))))))
#Nil))
@@ -843,19 +841,20 @@
(return (#Cons (_ann (#Form (#Cons (_ann (#Text "lux function"))
(#Cons (_ann (#Symbol "" self))
(#Cons arg
- (#Cons ("lux case" args'
- {#Nil
+ (#Cons ({#Nil
body
_
(_ann (#Form (#Cons (_ann (#Symbol "lux" "function''"))
(#Cons (_ann (#Tuple args'))
- (#Cons body #Nil)))))})
+ (#Cons body #Nil)))))}
+ args')
#Nil))))))
#Nil))
_
- (fail "Wrong syntax for function''")})))
+ (fail "Wrong syntax for function''")}
+ tokens)))
(record$ default-macro-meta))
("lux def" cursor-code
@@ -919,8 +918,7 @@
("lux def" def:''
("lux check" Macro
(function'' [tokens]
- ("lux case" tokens
- {(#Cons [[_ (#Tag ["" "export"])]
+ ({(#Cons [[_ (#Tag ["" "export"])]
(#Cons [[_ (#Form (#Cons [name args]))]
(#Cons [meta (#Cons [type (#Cons [body #Nil])])])])])
(return (#Cons [(_ann (#Form (#Cons [(_ann (#Text "lux def"))
@@ -982,15 +980,14 @@
#Nil]))
_
- (fail "Wrong syntax for def''")})
- ))
+ (fail "Wrong syntax for def''")}
+ tokens)))
(record$ default-macro-meta))
(def:'' (macro:' tokens)
default-macro-meta
Macro
- ("lux case" tokens
- {(#Cons [_ (#Form (#Cons name args))] (#Cons body #Nil))
+ ({(#Cons [_ (#Form (#Cons name args))] (#Cons body #Nil))
(return (#Cons (form$ (#Cons (symbol$ ["lux" "def:''"])
(#Cons (form$ (#Cons name args))
(#Cons (with-macro-meta (tag$ ["lux" "Nil"]))
@@ -1023,7 +1020,8 @@
#Nil))
_
- (fail "Wrong syntax for macro:'")}))
+ (fail "Wrong syntax for macro:'")}
+ tokens))
(macro:' #export (comment tokens)
(#Cons [(tag$ ["lux" "doc"])
@@ -1034,8 +1032,7 @@
(return #Nil))
(macro:' ($' tokens)
- ("lux case" tokens
- {(#Cons x #Nil)
+ ({(#Cons x #Nil)
(return tokens)
(#Cons x (#Cons y xs))
@@ -1046,7 +1043,8 @@
#Nil))
_
- (fail "Wrong syntax for $'")}))
+ (fail "Wrong syntax for $'")}
+ tokens))
(def:'' (list/map f xs)
#Nil
@@ -1055,12 +1053,12 @@
(#Function (#Function (#Parameter +3) (#Parameter +1))
(#Function ($' List (#Parameter +3))
($' List (#Parameter +1))))))
- ("lux case" xs
- {#Nil
+ ({#Nil
#Nil
(#Cons x xs')
- (#Cons (f x) (list/map f xs'))}))
+ (#Cons (f x) (list/map f xs'))}
+ xs))
(def:'' RepEnv
#Nil
@@ -1070,12 +1068,12 @@
(def:'' (make-env xs ys)
#Nil
(#Function ($' List Text) (#Function ($' List Code) RepEnv))
- ("lux case" [xs ys]
- {[(#Cons x xs') (#Cons y ys')]
+ ({[(#Cons x xs') (#Cons y ys')]
(#Cons [x y] (make-env xs' ys'))
_
- #Nil}))
+ #Nil}
+ [xs ys]))
(def:'' (text/= x y)
#Nil
@@ -1085,29 +1083,28 @@
(def:'' (get-rep key env)
#Nil
(#Function Text (#Function RepEnv ($' Maybe Code)))
- ("lux case" env
- {#Nil
+ ({#Nil
#None
(#Cons [k v] env')
- ("lux case" (text/= k key)
- {true
+ ({true
(#Some v)
false
- (get-rep key env')})}))
+ (get-rep key env')}
+ (text/= k key))}
+ env))
(def:'' (replace-syntax reps syntax)
#Nil
(#Function RepEnv (#Function Code Code))
- ("lux case" syntax
- {[_ (#Symbol "" name)]
- ("lux case" (get-rep name reps)
- {(#Some replacement)
+ ({[_ (#Symbol "" name)]
+ ({(#Some replacement)
replacement
#None
- syntax})
+ syntax}
+ (get-rep name reps))
[meta (#Form parts)]
[meta (#Form (list/map (replace-syntax reps) parts))]
@@ -1118,14 +1115,14 @@
[meta (#Record slots)]
[meta (#Record (list/map ("lux check" (#Function (#Product Code Code) (#Product Code Code))
(function'' [slot]
- ("lux case" slot
- {[k v]
- [(replace-syntax reps k) (replace-syntax reps v)]})))
+ ({[k v]
+ [(replace-syntax reps k) (replace-syntax reps v)]}
+ slot)))
slots))]
_
- syntax})
- )
+ syntax}
+ syntax))
(def:'' (n/+ param subject)
(#.Cons (doc-meta "Nat(ural) addition.")
@@ -1154,8 +1151,7 @@
(def:'' (update-parameters code)
#Nil
(#Function Code Code)
- ("lux case" code
- {[_ (#Tuple members)]
+ ({[_ (#Tuple members)]
(tuple$ (list/map update-parameters members))
[_ (#Record pairs)]
@@ -1172,7 +1168,8 @@
(form$ (list/map update-parameters members))
_
- code}))
+ code}
+ code))
(def:'' (parse-quantified-args args next)
#Nil
@@ -1181,8 +1178,7 @@
(#Function (#Function ($' List Text) (#Apply ($' List Code) Meta))
(#Apply ($' List Code) Meta)
))
- ("lux case" args
- {#Nil
+ ({#Nil
(next #Nil)
(#Cons [_ (#Symbol "" arg-name)] args')
@@ -1190,7 +1186,7 @@
_
(fail "Expected symbol.")}
- ))
+ args))
(def:'' (make-parameter idx)
#Nil
@@ -1206,12 +1202,12 @@
(#Function (#Parameter +3)
(#Function ($' List (#Parameter +1))
(#Parameter +3))))))
- ("lux case" xs
- {#Nil
+ ({#Nil
init
(#Cons x xs')
- (list/fold f (f x init) xs')}))
+ (list/fold f (f x init) xs')}
+ xs))
(def:'' (list/size list)
#Nil
@@ -1230,14 +1226,13 @@
(| Any
[a (List a)]))")]
#Nil)
- (let'' [self-name tokens] ("lux case" tokens
- {(#Cons [_ (#Symbol "" self-name)] tokens)
+ (let'' [self-name tokens] ({(#Cons [_ (#Symbol "" self-name)] tokens)
[self-name tokens]
_
- ["" tokens]})
- ("lux case" tokens
- {(#Cons [_ (#Tuple args)] (#Cons body #Nil))
+ ["" tokens]}
+ tokens)
+ ({(#Cons [_ (#Tuple args)] (#Cons body #Nil))
(parse-quantified-args args
(function'' [names]
(let'' body' (list/fold ("lux check" (#Function Text (#Function Code Code))
@@ -1248,8 +1243,7 @@
(update-parameters body')) #Nil))))))
body
names)
- (return (#Cons ("lux case" [(text/= "" self-name) names]
- {[true _]
+ (return (#Cons ({[true _]
body'
[_ #Nil]
@@ -1258,12 +1252,13 @@
[false _]
(replace-syntax (#Cons [self-name (make-parameter (n/* +2 (n/- +1 (list/size names))))]
#Nil)
- body')})
+ body')}
+ [(text/= "" self-name) names])
#Nil)))))
_
- (fail "Wrong syntax for All")})
- ))
+ (fail "Wrong syntax for All")}
+ tokens)))
(macro:' #export (Ex tokens)
(#Cons [(tag$ ["lux" "doc"])
@@ -1278,14 +1273,13 @@
a
(List (Self a))])")]
#Nil)
- (let'' [self-name tokens] ("lux case" tokens
- {(#Cons [_ (#Symbol "" self-name)] tokens)
+ (let'' [self-name tokens] ({(#Cons [_ (#Symbol "" self-name)] tokens)
[self-name tokens]
_
- ["" tokens]})
- ("lux case" tokens
- {(#Cons [_ (#Tuple args)] (#Cons body #Nil))
+ ["" tokens]}
+ tokens)
+ ({(#Cons [_ (#Tuple args)] (#Cons body #Nil))
(parse-quantified-args args
(function'' [names]
(let'' body' (list/fold ("lux check" (#Function Text (#Function Code Code))
@@ -1296,8 +1290,7 @@
(update-parameters body')) #Nil))))))
body
names)
- (return (#Cons ("lux case" [(text/= "" self-name) names]
- {[true _]
+ (return (#Cons ({[true _]
body'
[_ #Nil]
@@ -1306,12 +1299,13 @@
[false _]
(replace-syntax (#Cons [self-name (make-parameter (n/* +2 (n/- +1 (list/size names))))]
#Nil)
- body')})
+ body')}
+ [(text/= "" self-name) names])
#Nil)))))
_
- (fail "Wrong syntax for Ex")})
- ))
+ (fail "Wrong syntax for Ex")}
+ tokens)))
(def:'' (list/reverse list)
#Nil
@@ -1328,8 +1322,7 @@
## This is the type of a function that takes 2 Ints and returns an Int.")]
#Nil)
- ("lux case" (list/reverse tokens)
- {(#Cons output inputs)
+ ({(#Cons output inputs)
(return (#Cons (list/fold ("lux check" (#Function Code (#Function Code Code))
(function'' [i o] (form$ (#Cons (tag$ ["lux" "Function"]) (#Cons i (#Cons o #Nil))))))
output
@@ -1337,7 +1330,8 @@
#Nil))
_
- (fail "Wrong syntax for ->")}))
+ (fail "Wrong syntax for ->")}
+ (list/reverse tokens)))
(macro:' #export (list xs)
(#Cons [(tag$ ["lux" "doc"])
@@ -1358,8 +1352,7 @@
## In other words, this macro prepends elements to another list.
(list& 1 2 3 (list 4 5 6))")]
#Nil)
- ("lux case" (list/reverse xs)
- {(#Cons last init)
+ ({(#Cons last init)
(return (list (list/fold (function'' [head tail]
(form$ (list (tag$ ["lux" "Cons"])
(tuple$ (list head tail)))))
@@ -1367,7 +1360,8 @@
init)))
_
- (fail "Wrong syntax for list&")}))
+ (fail "Wrong syntax for list&")}
+ (list/reverse xs)))
(macro:' #export (& tokens)
(#Cons [(tag$ ["lux" "doc"])
@@ -1377,15 +1371,14 @@
## Any.
(&)")]
#Nil)
- ("lux case" (list/reverse tokens)
- {#Nil
+ ({#Nil
(return (list (symbol$ ["lux" "Any"])))
(#Cons last prevs)
(return (list (list/fold (function'' [left right] (form$ (list (tag$ ["lux" "Product"]) left right)))
last
prevs)))}
- ))
+ (list/reverse tokens)))
(macro:' #export (| tokens)
(#Cons [(tag$ ["lux" "doc"])
@@ -1395,27 +1388,24 @@
## Nothing.
(|)")]
#Nil)
- ("lux case" (list/reverse tokens)
- {#Nil
+ ({#Nil
(return (list (symbol$ ["lux" "Nothing"])))
(#Cons last prevs)
(return (list (list/fold (function'' [left right] (form$ (list (tag$ ["lux" "Sum"]) left right)))
last
prevs)))}
- ))
+ (list/reverse tokens)))
(macro:' (function' tokens)
- (let'' [name tokens'] ("lux case" tokens
- {(#Cons [[_ (#Symbol ["" name])] tokens'])
+ (let'' [name tokens'] ({(#Cons [[_ (#Symbol ["" name])] tokens'])
[name tokens']
_
- ["" tokens]})
- ("lux case" tokens'
- {(#Cons [[_ (#Tuple args)] (#Cons [body #Nil])])
- ("lux case" args
- {#Nil
+ ["" tokens]}
+ tokens)
+ ({(#Cons [[_ (#Tuple args)] (#Cons [body #Nil])])
+ ({#Nil
(fail "function' requires a non-empty arguments tuple.")
(#Cons [harg targs])
@@ -1428,14 +1418,15 @@
arg
body')))
body
- (list/reverse targs))))))})
+ (list/reverse targs))))))}
+ args)
_
- (fail "Wrong syntax for function'")})))
+ (fail "Wrong syntax for function'")}
+ tokens')))
(macro:' (def:''' tokens)
- ("lux case" tokens
- {(#Cons [[_ (#Tag ["" "export"])]
+ ({(#Cons [[_ (#Tag ["" "export"])]
(#Cons [[_ (#Form (#Cons [name args]))]
(#Cons [meta (#Cons [type (#Cons [body #Nil])])])])])
(return (list (form$ (list (text$ "lux def")
@@ -1484,45 +1475,45 @@
_
(fail "Wrong syntax for def'''")}
- ))
+ tokens))
(def:''' (as-pairs xs)
#Nil
(All [a] (-> ($' List a) ($' List (& a a))))
- ("lux case" xs
- {(#Cons x (#Cons y xs'))
+ ({(#Cons x (#Cons y xs'))
(#Cons [x y] (as-pairs xs'))
_
- #Nil}))
+ #Nil}
+ xs))
(macro:' (let' tokens)
- ("lux case" tokens
- {(#Cons [[_ (#Tuple bindings)] (#Cons [body #Nil])])
+ ({(#Cons [[_ (#Tuple bindings)] (#Cons [body #Nil])])
(return (list (list/fold ("lux check" (-> (& Code Code) Code
Code)
(function' [binding body]
- ("lux case" binding
- {[label value]
- (form$ (list (text$ "lux case") value (record$ (list [label body]))))})))
+ ({[label value]
+ (form$ (list (record$ (list [label body])) value))}
+ binding)))
body
(list/reverse (as-pairs bindings)))))
_
- (fail "Wrong syntax for let'")}))
+ (fail "Wrong syntax for let'")}
+ tokens))
(def:''' (any? p xs)
#Nil
(All [a]
(-> (-> a Bool) ($' List a) Bool))
- ("lux case" xs
- {#Nil
+ ({#Nil
false
(#Cons x xs')
- ("lux case" (p x)
- {true true
- false (any? p xs')})}))
+ ({true true
+ false (any? p xs')}
+ (p x))}
+ xs))
(def:''' (wrap-meta content)
#Nil
@@ -1533,42 +1524,42 @@
(def:''' (untemplate-list tokens)
#Nil
(-> ($' List Code) Code)
- ("lux case" tokens
- {#Nil
+ ({#Nil
(_ann (#Tag ["lux" "Nil"]))
(#Cons [token tokens'])
- (_ann (#Form (list (_ann (#Tag ["lux" "Cons"])) token (untemplate-list tokens'))))}))
+ (_ann (#Form (list (_ann (#Tag ["lux" "Cons"])) token (untemplate-list tokens'))))}
+ tokens))
(def:''' (list/compose xs ys)
#Nil
(All [a] (-> ($' List a) ($' List a) ($' List a)))
- ("lux case" xs
- {(#Cons x xs')
+ ({(#Cons x xs')
(#Cons x (list/compose xs' ys))
#Nil
- ys}))
+ ys}
+ xs))
(def:''' #export (splice-helper xs ys)
#Nil
(-> ($' List Code) ($' List Code) ($' List Code))
- ("lux case" xs
- {(#Cons x xs')
+ ({(#Cons x xs')
(#Cons x (splice-helper xs' ys))
#Nil
- ys}))
+ ys}
+ xs))
(def:''' (_$_joiner op a1 a2)
#Nil
(-> Code Code Code Code)
- ("lux case" op
- {[_ (#Form parts)]
+ ({[_ (#Form parts)]
(form$ (list/compose parts (list a1 a2)))
_
- (form$ (list op a1 a2))}))
+ (form$ (list op a1 a2))}
+ op))
(macro:' #export (_$ tokens)
(#Cons [(tag$ ["lux" "doc"])
@@ -1578,17 +1569,17 @@
## =>
(text/compose (text/compose \"Hello, \" name) \".\\nHow are you?\")")]
#Nil)
- ("lux case" tokens
- {(#Cons op tokens')
- ("lux case" tokens'
- {(#Cons first nexts)
+ ({(#Cons op tokens')
+ ({(#Cons first nexts)
(return (list (list/fold (_$_joiner op) first nexts)))
_
- (fail "Wrong syntax for _$")})
+ (fail "Wrong syntax for _$")}
+ tokens')
_
- (fail "Wrong syntax for _$")}))
+ (fail "Wrong syntax for _$")}
+ tokens))
(macro:' #export ($_ tokens)
(#Cons [(tag$ ["lux" "doc"])
@@ -1598,17 +1589,17 @@
## =>
(text/compose \"Hello, \" (text/compose name \".\\nHow are you?\"))")]
#Nil)
- ("lux case" tokens
- {(#Cons op tokens')
- ("lux case" (list/reverse tokens')
- {(#Cons last prevs)
+ ({(#Cons op tokens')
+ ({(#Cons last prevs)
(return (list (list/fold (_$_joiner op) last prevs)))
_
- (fail "Wrong syntax for $_")})
+ (fail "Wrong syntax for $_")}
+ (list/reverse tokens'))
_
- (fail "Wrong syntax for $_")}))
+ (fail "Wrong syntax for $_")}
+ tokens))
## (sig: (Monad m)
## (: (All [a] (-> a (m a)))
@@ -1635,9 +1626,9 @@
#bind
(function' [f ma]
- ("lux case" ma
- {#None #None
- (#Some a) (f a)}))})
+ ({#None #None
+ (#Some a) (f a)}
+ ma))})
(def:''' Monad<Meta>
#Nil
@@ -1650,38 +1641,37 @@
#bind
(function' [f ma]
(function' [state]
- ("lux case" (ma state)
- {(#Left msg)
+ ({(#Left msg)
(#Left msg)
(#Right state' a)
- (f a state')})))})
+ (f a state')}
+ (ma state))))})
(macro:' (do tokens)
- ("lux case" tokens
- {(#Cons monad (#Cons [_ (#Tuple bindings)] (#Cons body #Nil)))
+ ({(#Cons monad (#Cons [_ (#Tuple bindings)] (#Cons body #Nil)))
(let' [g!wrap (symbol$ ["" "wrap"])
g!bind (symbol$ ["" " bind "])
body' (list/fold ("lux check" (-> (& Code Code) Code Code)
(function' [binding body']
(let' [[var value] binding]
- ("lux case" var
- {[_ (#Tag "" "let")]
+ ({[_ (#Tag "" "let")]
(form$ (list (symbol$ ["lux" "let'"]) value body'))
_
(form$ (list g!bind
(form$ (list (text$ "lux function") (symbol$ ["" ""]) var body'))
- value))}))))
+ value))}
+ var))))
body
(list/reverse (as-pairs bindings)))]
- (return (list (form$ (list (text$ "lux case")
- monad
- (record$ (list [(record$ (list [(tag$ ["lux" "wrap"]) g!wrap] [(tag$ ["lux" "bind"]) g!bind]))
- body'])))))))
+ (return (list (form$ (list (record$ (list [(record$ (list [(tag$ ["lux" "wrap"]) g!wrap] [(tag$ ["lux" "bind"]) g!bind]))
+ body']))
+ monad)))))
_
- (fail "Wrong syntax for do")}))
+ (fail "Wrong syntax for do")}
+ tokens))
(def:''' (monad/map m f xs)
#Nil
@@ -1693,16 +1683,15 @@
($' List a)
($' m ($' List b))))
(let' [{#wrap wrap #bind _} m]
- ("lux case" xs
- {#Nil
+ ({#Nil
(wrap #Nil)
(#Cons x xs')
(do m
[y (f x)
ys (monad/map m f xs')]
- (wrap (#Cons y ys)))
- })))
+ (wrap (#Cons y ys)))}
+ xs)))
(def:''' (monad/fold m f y xs)
#Nil
@@ -1715,15 +1704,14 @@
($' List a)
($' m b)))
(let' [{#wrap wrap #bind _} m]
- ("lux case" xs
- {#Nil
+ ({#Nil
(wrap y)
(#Cons x xs')
(do m
[y' (f x y)]
- (monad/fold m f y' xs'))
- })))
+ (monad/fold m f y' xs'))}
+ xs)))
(macro:' #export (if tokens)
(list [(tag$ ["lux" "doc"])
@@ -1734,40 +1722,40 @@
\"Aw hell naw!\")
=> \"Oh, yeah!\"")])
- ("lux case" tokens
- {(#Cons test (#Cons then (#Cons else #Nil)))
- (return (list (form$ (list (text$ "lux case") test
- (record$ (list [(bool$ true) then]
- [(bool$ false) else]))))))
+ ({(#Cons test (#Cons then (#Cons else #Nil)))
+ (return (list (form$ (list (record$ (list [(bool$ true) then]
+ [(bool$ false) else]))
+ test))))
_
- (fail "Wrong syntax for if")}))
+ (fail "Wrong syntax for if")}
+ tokens))
(def:''' (get k plist)
#Nil
(All [a]
(-> Text ($' List (& Text a)) ($' Maybe a)))
- ("lux case" plist
- {(#Cons [[k' v] plist'])
+ ({(#Cons [[k' v] plist'])
(if (text/= k k')
(#Some v)
(get k plist'))
#Nil
- #None}))
+ #None}
+ plist))
(def:''' (put k v dict)
#Nil
(All [a]
(-> Text a ($' List (& Text a)) ($' List (& Text a))))
- ("lux case" dict
- {#Nil
+ ({#Nil
(list [k v])
(#Cons [[k' v'] dict'])
(if (text/= k k')
(#Cons [[k' v] dict'])
- (#Cons [[k' v'] (put k v dict')]))}))
+ (#Cons [[k' v'] (put k v dict')]))}
+ dict))
(def:''' #export (log! message)
(list [(tag$ ["lux" "doc"])
@@ -1786,36 +1774,36 @@
#Nil
(-> Ident Text)
(let' [[module name] ident]
- ("lux case" module
- {"" name
- _ ($_ text/compose module "." name)})))
+ ({"" name
+ _ ($_ text/compose module "." name)}
+ module)))
(def:''' (get-meta tag def-meta)
#Nil
(-> Ident Code ($' Maybe Code))
(let' [[prefix name] tag]
- ("lux case" def-meta
- {[_ (#Record def-meta)]
- ("lux case" def-meta
- {(#Cons [key value] def-meta')
- ("lux case" key
- {[_ (#Tag [prefix' name'])]
- ("lux case" [(text/= prefix prefix')
- (text/= name name')]
- {[true true]
+ ({[_ (#Record def-meta)]
+ ({(#Cons [key value] def-meta')
+ ({[_ (#Tag [prefix' name'])]
+ ({[true true]
(#Some value)
_
- (get-meta tag (record$ def-meta'))})
+ (get-meta tag (record$ def-meta'))}
+ [(text/= prefix prefix')
+ (text/= name name')])
_
- (get-meta tag (record$ def-meta'))})
+ (get-meta tag (record$ def-meta'))}
+ key)
#Nil
- #None})
+ #None}
+ def-meta)
_
- #None})))
+ #None}
+ def-meta)))
(def:''' (resolve-global-symbol ident state)
#Nil
@@ -1825,47 +1813,44 @@
#scopes scopes #type-context types #host host
#seed seed #expected expected #cursor cursor #extensions extensions
#scope-type-vars scope-type-vars} state]
- ("lux case" (get module modules)
- {(#Some {#module-hash _ #module-aliases _ #definitions definitions #imports _ #tags tags #types types #module-annotations _ #module-state _})
- ("lux case" (get name definitions)
- {(#Some [def-type def-meta def-value])
- ("lux case" (get-meta ["lux" "alias"] def-meta)
- {(#Some [_ (#Symbol real-name)])
+ ({(#Some {#module-hash _ #module-aliases _ #definitions definitions #imports _ #tags tags #types types #module-annotations _ #module-state _})
+ ({(#Some [def-type def-meta def-value])
+ ({(#Some [_ (#Symbol real-name)])
(#Right [state real-name])
_
- (#Right [state ident])})
+ (#Right [state ident])}
+ (get-meta ["lux" "alias"] def-meta))
#None
- (#Left ($_ text/compose "Unknown definition: " (ident/encode ident)))})
+ (#Left ($_ text/compose "Unknown definition: " (ident/encode ident)))}
+ (get name definitions))
#None
- (#Left ($_ text/compose "Unknown module: " module " @ " (ident/encode ident)))})))
+ (#Left ($_ text/compose "Unknown module: " module " @ " (ident/encode ident)))}
+ (get module modules))))
(def:''' (splice replace? untemplate elems)
#Nil
(-> Bool (-> Code ($' Meta Code)) ($' List Code) ($' Meta Code))
- ("lux case" replace?
- {true
- ("lux case" (list/reverse elems)
- {#Nil
+ ({true
+ ({#Nil
(return (tag$ ["lux" "Nil"]))
(#Cons lastI inits)
(do Monad<Meta>
- [lastO ("lux case" lastI
- {[_ (#Form (#Cons [[_ (#Symbol ["" "~+"])] (#Cons [spliced #Nil])]))]
+ [lastO ({[_ (#Form (#Cons [[_ (#Symbol ["" "~+"])] (#Cons [spliced #Nil])]))]
(let' [[[_module-name _ _] _] spliced]
(wrap spliced))
_
(do Monad<Meta>
[lastO (untemplate lastI)]
- (wrap (form$ (list (tag$ ["lux" "Cons"]) (tuple$ (list lastO (tag$ ["lux" "Nil"])))))))})]
+ (wrap (form$ (list (tag$ ["lux" "Cons"]) (tuple$ (list lastO (tag$ ["lux" "Nil"])))))))}
+ lastI)]
(monad/fold Monad<Meta>
(function' [leftI rightO]
- ("lux case" leftI
- {[_ (#Form (#Cons [[_ (#Symbol ["" "~+"])] (#Cons [spliced #Nil])]))]
+ ({[_ (#Form (#Cons [[_ (#Symbol ["" "~+"])] (#Cons [spliced #Nil])]))]
(let' [[[_module-name _ _] _] spliced]
(wrap (form$ (list (symbol$ ["lux" "splice-helper"])
spliced
@@ -1874,13 +1859,16 @@
_
(do Monad<Meta>
[leftO (untemplate leftI)]
- (wrap (form$ (list (tag$ ["lux" "Cons"]) (tuple$ (list leftO rightO))))))}))
+ (wrap (form$ (list (tag$ ["lux" "Cons"]) (tuple$ (list leftO rightO))))))}
+ leftI))
lastO
- inits))})
+ inits))}
+ (list/reverse elems))
false
(do Monad<Meta>
[=elems (monad/map Monad<Meta> untemplate elems)]
- (wrap (untemplate-list =elems)))}))
+ (wrap (untemplate-list =elems)))}
+ replace?))
(def:''' (untemplate-text value)
#Nil
@@ -1890,8 +1878,7 @@
(def:''' (untemplate replace? subst token)
#Nil
(-> Bool Text Code ($' Meta Code))
- ("lux case" [replace? token]
- {[_ [_ (#Bool value)]]
+ ({[_ [_ (#Bool value)]]
(return (wrap-meta (form$ (list (tag$ ["lux" "Bool"]) (bool$ value)))))
[_ [_ (#Nat value)]]
@@ -1913,24 +1900,24 @@
(return (wrap-meta (form$ (list (tag$ ["lux" "Tag"]) (tuple$ (list (text$ module) (text$ name)))))))
[true [_ (#Tag [module name])]]
- (let' [module' ("lux case" module
- {""
+ (let' [module' ({""
subst
_
- module})]
+ module}
+ module)]
(return (wrap-meta (form$ (list (tag$ ["lux" "Tag"]) (tuple$ (list (text$ module') (text$ name))))))))
[true [_ (#Symbol [module name])]]
(do Monad<Meta>
- [real-name ("lux case" module
- {""
+ [real-name ({""
(if (text/= "" subst)
(wrap [module name])
(resolve-global-symbol [subst name]))
_
- (wrap [module name])})
+ (wrap [module name])}
+ module)
#let [[module name] real-name]]
(return (wrap-meta (form$ (list (tag$ ["lux" "Symbol"]) (tuple$ (list (text$ module) (text$ name))))))))
@@ -1975,7 +1962,7 @@
(wrap (tuple$ (list =k =v)))))))
fields)]
(wrap (wrap-meta (form$ (list (tag$ ["lux" "Record"]) (untemplate-list =fields))))))}
- ))
+ [replace? token]))
(macro:' #export (primitive tokens)
(list [(tag$ ["lux" "doc"])
@@ -1983,31 +1970,30 @@
(primitive \"java.lang.Object\")
(primitive \"java.util.List\" [(primitive \"java.lang.Long\")])")])
- ("lux case" tokens
- {(#Cons [_ (#Text class-name)] #Nil)
+ ({(#Cons [_ (#Text class-name)] #Nil)
(return (list (form$ (list (tag$ ["lux" "Primitive"]) (text$ class-name) (tag$ ["lux" "Nil"])))))
(#Cons [_ (#Text class-name)] (#Cons [_ (#Tuple params)] #Nil))
(return (list (form$ (list (tag$ ["lux" "Primitive"]) (text$ class-name) (untemplate-list params)))))
_
- (fail "Wrong syntax for primitive")}))
+ (fail "Wrong syntax for primitive")}
+ tokens))
(def:'' (current-module-name state)
#Nil
($' Meta Text)
- ("lux case" state
- {{#info info #source source #current-module current-module #modules modules
+ ({{#info info #source source #current-module current-module #modules modules
#scopes scopes #type-context types #host host
#seed seed #expected expected #cursor cursor #extensions extensions
#scope-type-vars scope-type-vars}
- ("lux case" current-module
- {(#Some module-name)
+ ({(#Some module-name)
(#Right [state module-name])
_
(#Left "Cannot get the module name without a module!")}
- )}))
+ current-module)}
+ state))
(macro:' #export (` tokens)
(list [(tag$ ["lux" "doc"])
@@ -2016,8 +2002,7 @@
(` (def: (~ name)
(function ((~' _) (~+ args))
(~ body))))")])
- ("lux case" tokens
- {(#Cons template #Nil)
+ ({(#Cons template #Nil)
(do Monad<Meta>
[current-module current-module-name
=template (untemplate true current-module template)]
@@ -2026,7 +2011,8 @@
=template)))))
_
- (fail "Wrong syntax for `")}))
+ (fail "Wrong syntax for `")}
+ tokens))
(macro:' #export (`' tokens)
(list [(tag$ ["lux" "doc"])
@@ -2034,27 +2020,27 @@
(`' (def: (~ name)
(function (_ (~+ args))
(~ body))))")])
- ("lux case" tokens
- {(#Cons template #Nil)
+ ({(#Cons template #Nil)
(do Monad<Meta>
[=template (untemplate true "" template)]
(wrap (list (form$ (list (text$ "lux check") (symbol$ ["lux" "Code"]) =template)))))
_
- (fail "Wrong syntax for `")}))
+ (fail "Wrong syntax for `")}
+ tokens))
(macro:' #export (' tokens)
(list [(tag$ ["lux" "doc"])
(text$ "## Quotation as a macro.
(' \"YOLO\")")])
- ("lux case" tokens
- {(#Cons template #Nil)
+ ({(#Cons template #Nil)
(do Monad<Meta>
[=template (untemplate false "" template)]
(wrap (list (form$ (list (text$ "lux check") (symbol$ ["lux" "Code"]) =template)))))
_
- (fail "Wrong syntax for '")}))
+ (fail "Wrong syntax for '")}
+ tokens))
(macro:' #export (|> tokens)
(list [(tag$ ["lux" "doc"])
@@ -2065,24 +2051,24 @@
(fold text/compose \"\"
(interpose \" \"
(list/map int/encode elems)))")])
- ("lux case" tokens
- {(#Cons [init apps])
+ ({(#Cons [init apps])
(return (list (list/fold ("lux check" (-> Code Code Code)
(function' [app acc]
- ("lux case" app
- {[_ (#Tuple parts)]
+ ({[_ (#Tuple parts)]
(tuple$ (list/compose parts (list acc)))
[_ (#Form parts)]
(form$ (list/compose parts (list acc)))
_
- (` ((~ app) (~ acc)))})))
+ (` ((~ app) (~ acc)))}
+ app)))
init
apps)))
_
- (fail "Wrong syntax for |>")}))
+ (fail "Wrong syntax for |>")}
+ tokens))
(macro:' #export (<| tokens)
(list [(tag$ ["lux" "doc"])
@@ -2093,24 +2079,24 @@
(fold text/compose \"\"
(interpose \" \"
(list/map int/encode elems)))")])
- ("lux case" (list/reverse tokens)
- {(#Cons [init apps])
+ ({(#Cons [init apps])
(return (list (list/fold ("lux check" (-> Code Code Code)
(function' [app acc]
- ("lux case" app
- {[_ (#Tuple parts)]
+ ({[_ (#Tuple parts)]
(tuple$ (list/compose parts (list acc)))
[_ (#Form parts)]
(form$ (list/compose parts (list acc)))
_
- (` ((~ app) (~ acc)))})))
+ (` ((~ app) (~ acc)))}
+ app)))
init
apps)))
_
- (fail "Wrong syntax for <|")}))
+ (fail "Wrong syntax for <|")}
+ (list/reverse tokens)))
(def:''' (compose f g)
(list [(tag$ ["lux" "doc"])
@@ -2122,54 +2108,53 @@
(def:''' (get-ident x)
#Nil
(-> Code ($' Maybe Ident))
- ("lux case" x
- {[_ (#Symbol sname)]
+ ({[_ (#Symbol sname)]
(#Some sname)
_
- #None}))
+ #None}
+ x))
(def:''' (get-tag x)
#Nil
(-> Code ($' Maybe Ident))
- ("lux case" x
- {[_ (#Tag sname)]
+ ({[_ (#Tag sname)]
(#Some sname)
_
- #None}))
+ #None}
+ x))
(def:''' (get-name x)
#Nil
(-> Code ($' Maybe Text))
- ("lux case" x
- {[_ (#Symbol "" sname)]
+ ({[_ (#Symbol "" sname)]
(#Some sname)
_
- #None}))
+ #None}
+ x))
(def:''' (tuple->list tuple)
#Nil
(-> Code ($' Maybe ($' List Code)))
- ("lux case" tuple
- {[_ (#Tuple members)]
+ ({[_ (#Tuple members)]
(#Some members)
_
- #None}))
+ #None}
+ tuple))
(def:''' (apply-template env template)
#Nil
(-> RepEnv Code Code)
- ("lux case" template
- {[_ (#Symbol "" sname)]
- ("lux case" (get-rep sname env)
- {(#Some subst)
+ ({[_ (#Symbol "" sname)]
+ ({(#Some subst)
subst
_
- template})
+ template}
+ (get-rep sname env))
[meta (#Tuple elems)]
[meta (#Tuple (list/map (apply-template env) elems))]
@@ -2185,18 +2170,19 @@
members))]
_
- template}))
+ template}
+ template))
(def:''' (join-map f xs)
#Nil
(All [a b]
(-> (-> a ($' List b)) ($' List a) ($' List b)))
- ("lux case" xs
- {#Nil
+ ({#Nil
#Nil
(#Cons [x xs'])
- (list/compose (f x) (join-map f xs'))}))
+ (list/compose (f x) (join-map f xs'))}
+ xs))
(def:''' (every? p xs)
#Nil
@@ -2273,11 +2259,8 @@
[inc 1]
[dec -1])")])
- ("lux case" tokens
- {(#Cons [[_ (#Tuple bindings)] (#Cons [[_ (#Tuple templates)] data])])
- ("lux case" [(monad/map Monad<Maybe> get-name bindings)
- (monad/map Monad<Maybe> tuple->list data)]
- {[(#Some bindings') (#Some data')]
+ ({(#Cons [[_ (#Tuple bindings)] (#Cons [[_ (#Tuple templates)] data])])
+ ({[(#Some bindings') (#Some data')]
(let' [apply ("lux check" (-> RepEnv ($' List Code))
(function' [env] (list/map (apply-template env) templates)))
num-bindings (list/size bindings')]
@@ -2289,10 +2272,13 @@
(fail "Irregular arguments tuples for do-template.")))
_
- (fail "Wrong syntax for do-template")})
+ (fail "Wrong syntax for do-template")}
+ [(monad/map Monad<Maybe> get-name bindings)
+ (monad/map Monad<Maybe> tuple->list data)])
_
- (fail "Wrong syntax for do-template")}))
+ (fail "Wrong syntax for do-template")}
+ tokens))
(def:''' #export (r/= test subject)
(list [(tag$ ["lux" "doc"])
@@ -2523,9 +2509,9 @@
("lux coerce" Rev
(let' [[trailing-zeroes remaining] (without-trailing-zeroes +0 numerator)]
(n// remaining
- ("lux case" trailing-zeroes
- {+0 ("lux coerce" Nat -1)
- _ ("lux i64 left-shift" (n/- trailing-zeroes +64) +1)})))))
+ ({+0 ("lux coerce" Nat -1)
+ _ ("lux i64 left-shift" (n/- trailing-zeroes +64) +1)}
+ trailing-zeroes)))))
(do-template [<name> <type> <test> <doc>]
[(def:''' #export (<name> left right)
@@ -2557,18 +2543,17 @@
(def:''' (digit-to-text digit)
#Nil
(-> Nat Text)
- ("lux case" digit
- {+0 "0"
+ ({+0 "0"
+1 "1" +2 "2" +3 "3"
+4 "4" +5 "5" +6 "6"
+7 "7" +8 "8" +9 "9"
- _ ("lux io error" "undefined")}))
+ _ ("lux io error" "undefined")}
+ digit))
(def:''' (nat/encode value)
#Nil
(-> Nat Text)
- ("lux case" value
- {+0
+ ({+0
"+0"
_
@@ -2579,7 +2564,8 @@
(recur (n// +10 input)
(text/compose (|> input (n/% +10) digit-to-text)
output)))))]
- (loop value ""))}))
+ (loop value ""))}
+ value))
(def:''' (int/abs value)
#Nil
@@ -2636,38 +2622,37 @@
gdef (let' [{#module-hash _ #module-aliases _ #definitions bindings #imports _ #tags tags #types types #module-annotations _ #module-state _} ("lux check" Module $module)]
(get name bindings))]
(let' [[def-type def-meta def-value] ("lux check" Definition gdef)]
- ("lux case" (get-meta ["lux" "macro?"] def-meta)
- {(#Some [_ (#Bool true)])
- ("lux case" (get-meta ["lux" "export?"] def-meta)
- {(#Some [_ (#Bool true)])
+ ({(#Some [_ (#Bool true)])
+ ({(#Some [_ (#Bool true)])
(#Some ("lux coerce" Macro def-value))
_
(if (text/= module current-module)
(#Some ("lux coerce" Macro def-value))
- #None)})
+ #None)}
+ (get-meta ["lux" "export?"] def-meta))
_
- ("lux case" (get-meta ["lux" "alias"] def-meta)
- {(#Some [_ (#Symbol [r-module r-name])])
+ ({(#Some [_ (#Symbol [r-module r-name])])
(find-macro' modules current-module r-module r-name)
_
- #None})}
- ))
+ #None}
+ (get-meta ["lux" "alias"] def-meta))}
+ (get-meta ["lux" "macro?"] def-meta)))
))
(def:''' (normalize ident)
#Nil
(-> Ident ($' Meta Ident))
- ("lux case" ident
- {["" name]
+ ({["" name]
(do Monad<Meta>
[module-name current-module-name]
(wrap [module-name name]))
_
- (return ident)}))
+ (return ident)}
+ ident))
(def:''' (find-macro ident)
#Nil
@@ -2676,13 +2661,13 @@
[current-module current-module-name]
(let' [[module name] ident]
(function' [state]
- ("lux case" state
- {{#info info #source source #current-module _ #modules modules
+ ({{#info info #source source #current-module _ #modules modules
#scopes scopes #type-context types #host host
#seed seed #expected expected
#cursor cursor #extensions extensions
#scope-type-vars scope-type-vars}
- (#Right state (find-macro' modules current-module module name))})))))
+ (#Right state (find-macro' modules current-module module name))}
+ state)))))
(def:''' (macro? ident)
#Nil
@@ -2690,9 +2675,9 @@
(do Monad<Meta>
[ident (normalize ident)
output (find-macro ident)]
- (wrap ("lux case" output
- {(#Some _) true
- #None false}))))
+ (wrap ({(#Some _) true
+ #None false}
+ output))))
(def:''' (list/join xs)
#Nil
@@ -2704,65 +2689,63 @@
#Nil
(All [a]
(-> a ($' List a) ($' List a)))
- ("lux case" xs
- {#Nil
+ ({#Nil
xs
(#Cons [x #Nil])
xs
(#Cons [x xs'])
- (list& x sep (interpose sep xs'))}))
+ (list& x sep (interpose sep xs'))}
+ xs))
(def:''' (macro-expand-once token)
#Nil
(-> Code ($' Meta ($' List Code)))
- ("lux case" token
- {[_ (#Form (#Cons [_ (#Symbol macro-name)] args))]
+ ({[_ (#Form (#Cons [_ (#Symbol macro-name)] args))]
(do Monad<Meta>
[macro-name' (normalize macro-name)
?macro (find-macro macro-name')]
- ("lux case" ?macro
- {(#Some macro)
+ ({(#Some macro)
(macro args)
#None
- (return (list token))}))
+ (return (list token))}
+ ?macro))
_
- (return (list token))}))
+ (return (list token))}
+ token))
(def:''' (macro-expand token)
#Nil
(-> Code ($' Meta ($' List Code)))
- ("lux case" token
- {[_ (#Form (#Cons [_ (#Symbol macro-name)] args))]
+ ({[_ (#Form (#Cons [_ (#Symbol macro-name)] args))]
(do Monad<Meta>
[macro-name' (normalize macro-name)
?macro (find-macro macro-name')]
- ("lux case" ?macro
- {(#Some macro)
+ ({(#Some macro)
(do Monad<Meta>
[expansion (macro args)
expansion' (monad/map Monad<Meta> macro-expand expansion)]
(wrap (list/join expansion')))
#None
- (return (list token))}))
+ (return (list token))}
+ ?macro))
_
- (return (list token))}))
+ (return (list token))}
+ token))
(def:''' (macro-expand-all syntax)
#Nil
(-> Code ($' Meta ($' List Code)))
- ("lux case" syntax
- {[_ (#Form (#Cons [_ (#Symbol macro-name)] args))]
+ ({[_ (#Form (#Cons [_ (#Symbol macro-name)] args))]
(do Monad<Meta>
[macro-name' (normalize macro-name)
?macro (find-macro macro-name')]
- ("lux case" ?macro
- {(#Some macro)
+ ({(#Some macro)
(do Monad<Meta>
[expansion (macro args)
expansion' (monad/map Monad<Meta> macro-expand-all expansion)]
@@ -2771,7 +2754,8 @@
#None
(do Monad<Meta>
[args' (monad/map Monad<Meta> macro-expand-all args)]
- (wrap (list (form$ (#Cons (symbol$ macro-name) (list/join args'))))))}))
+ (wrap (list (form$ (#Cons (symbol$ macro-name) (list/join args'))))))}
+ ?macro))
[_ (#Form members)]
(do Monad<Meta>
@@ -2790,23 +2774,23 @@
(let' [[key val] kv]
(do Monad<Meta>
[val' (macro-expand-all val)]
- ("lux case" val'
- {(#Cons val'' #Nil)
+ ({(#Cons val'' #Nil)
(return [key val''])
_
- (fail "The value-part of a KV-pair in a record must macro-expand to a single Code.")}))))
+ (fail "The value-part of a KV-pair in a record must macro-expand to a single Code.")}
+ val'))))
pairs)]
(wrap (list (record$ pairs'))))
_
- (return (list syntax))}))
+ (return (list syntax))}
+ syntax))
(def:''' (walk-type type)
#Nil
(-> Code Code)
- ("lux case" type
- {[_ (#Form (#Cons [_ (#Tag tag)] parts))]
+ ({[_ (#Form (#Cons [_ (#Tag tag)] parts))]
(form$ (#Cons [(tag$ tag) (list/map walk-type parts)]))
[_ (#Tuple members)]
@@ -2828,54 +2812,55 @@
(list/map walk-type args))
_
- type}))
+ type}
+ type))
(macro:' #export (type tokens)
(list [(tag$ ["lux" "doc"])
(text$ "## Takes a type expression and returns it's representation as data-structure.
(type (All [a] (Maybe (List a))))")])
- ("lux case" tokens
- {(#Cons type #Nil)
+ ({(#Cons type #Nil)
(do Monad<Meta>
[type+ (macro-expand-all type)]
- ("lux case" type+
- {(#Cons type' #Nil)
+ ({(#Cons type' #Nil)
(wrap (list (walk-type type')))
_
- (fail "The expansion of the type-syntax had to yield a single element.")}))
+ (fail "The expansion of the type-syntax had to yield a single element.")}
+ type+))
_
- (fail "Wrong syntax for type")}))
+ (fail "Wrong syntax for type")}
+ tokens))
(macro:' #export (: tokens)
(list [(tag$ ["lux" "doc"])
(text$ "## The type-annotation macro.
(: (List Int) (list 1 2 3))")])
- ("lux case" tokens
- {(#Cons type (#Cons value #Nil))
+ ({(#Cons type (#Cons value #Nil))
(return (list (` ("lux check" (type (~ type)) (~ value)))))
_
- (fail "Wrong syntax for :")}))
+ (fail "Wrong syntax for :")}
+ tokens))
(macro:' #export (:coerce tokens)
(list [(tag$ ["lux" "doc"])
(text$ "## The type-coercion macro.
(:coerce Dinosaur (list 1 2 3))")])
- ("lux case" tokens
- {(#Cons type (#Cons value #Nil))
+ ({(#Cons type (#Cons value #Nil))
(return (list (` ("lux coerce" (type (~ type)) (~ value)))))
_
- (fail "Wrong syntax for :coerce")}))
+ (fail "Wrong syntax for :coerce")}
+ tokens))
(def:''' (empty? xs)
#Nil
(All [a] (-> ($' List a) Bool))
- ("lux case" xs
- {#Nil true
- _ false}))
+ ({#Nil true
+ _ false}
+ xs))
(do-template [<name> <type> <value>]
[(def:''' (<name> xy)
@@ -2889,40 +2874,38 @@
(def:''' (unfold-type-def type-codes)
#Nil
(-> ($' List Code) ($' Meta (& Code ($' Maybe ($' List Text)))))
- ("lux case" type-codes
- {(#Cons [_ (#Record pairs)] #Nil)
+ ({(#Cons [_ (#Record pairs)] #Nil)
(do Monad<Meta>
[members (monad/map Monad<Meta>
(: (-> [Code Code] (Meta [Text Code]))
(function' [pair]
- ("lux case" pair
- {[[_ (#Tag "" member-name)] member-type]
+ ({[[_ (#Tag "" member-name)] member-type]
(return [member-name member-type])
_
- (fail "Wrong syntax for variant case.")})))
+ (fail "Wrong syntax for variant case.")}
+ pair)))
pairs)]
(return [(` (& (~+ (list/map second members))))
(#Some (list/map first members))]))
(#Cons type #Nil)
- ("lux case" type
- {[_ (#Tag "" member-name)]
+ ({[_ (#Tag "" member-name)]
(return [(` .Any) (#Some (list member-name))])
[_ (#Form (#Cons [_ (#Tag "" member-name)] member-types))]
(return [(` (& (~+ member-types))) (#Some (list member-name))])
_
- (return [type #None])})
+ (return [type #None])}
+ type)
(#Cons case cases)
(do Monad<Meta>
[members (monad/map Monad<Meta>
(: (-> Code (Meta [Text Code]))
(function' [case]
- ("lux case" case
- {[_ (#Tag "" member-name)]
+ ({[_ (#Tag "" member-name)]
(return [member-name (` .Any)])
[_ (#Form (#Cons [_ (#Tag "" member-name)] (#Cons member-type #Nil)))]
@@ -2932,19 +2915,20 @@
(return [member-name (` (& (~+ member-types)))])
_
- (fail "Wrong syntax for variant case.")})))
+ (fail "Wrong syntax for variant case.")}
+ case)))
(list& case cases))]
(return [(` (| (~+ (list/map second members))))
(#Some (list/map first members))]))
_
- (fail "Improper type-definition syntax")}))
+ (fail "Improper type-definition syntax")}
+ type-codes))
(def:''' (gensym prefix state)
#Nil
(-> Text ($' Meta Code))
- ("lux case" state
- {{#info info #source source #current-module _ #modules modules
+ ({{#info info #source source #current-module _ #modules modules
#scopes scopes #type-context types #host host
#seed seed #expected expected
#cursor cursor #extensions extensions
@@ -2954,7 +2938,8 @@
#seed (n/+ +1 seed) #expected expected
#cursor cursor #extensions extensions
#scope-type-vars scope-type-vars}
- (symbol$ ["" ($_ text/compose "__gensym__" prefix (nat/encode seed))]))}))
+ (symbol$ ["" ($_ text/compose "__gensym__" prefix (nat/encode seed))]))}
+ state))
(macro:' #export (Rec tokens)
(list [(tag$ ["lux" "doc"])
@@ -2962,14 +2947,14 @@
## A name has to be given to the whole type, to use it within its body.
(Rec Self
[Int (List Self)])")])
- ("lux case" tokens
- {(#Cons [_ (#Symbol "" name)] (#Cons body #Nil))
+ ({(#Cons [_ (#Symbol "" name)] (#Cons body #Nil))
(let' [body' (replace-syntax (list [name (` (#.Apply (~ (make-parameter +1)) (~ (make-parameter +0))))])
(update-parameters body))]
(return (list (` (#.Apply .Nothing (#.UnivQ #.Nil (~ body')))))))
_
- (fail "Wrong syntax for Rec")}))
+ (fail "Wrong syntax for Rec")}
+ tokens))
(macro:' #export (exec tokens)
(list [(tag$ ["lux" "doc"])
@@ -2979,27 +2964,27 @@
(log! \"#2\")
(log! \"#3\")
\"YOLO\")")])
- ("lux case" (list/reverse tokens)
- {(#Cons value actions)
+ ({(#Cons value actions)
(let' [dummy (symbol$ ["" ""])]
(return (list (list/fold ("lux check" (-> Code Code Code)
- (function' [pre post] (` ("lux case" (~ pre) {(~ dummy) (~ post)}))))
+ (function' [pre post] (` ({(~ dummy) (~ post)}
+ (~ pre)))))
value
actions))))
_
- (fail "Wrong syntax for exec")}))
+ (fail "Wrong syntax for exec")}
+ (list/reverse tokens)))
(macro:' (def:' tokens)
- (let' [[export? tokens'] ("lux case" tokens
- {(#Cons [_ (#Tag ["" "export"])] tokens')
+ (let' [[export? tokens'] ({(#Cons [_ (#Tag ["" "export"])] tokens')
[true tokens']
_
- [false tokens]})
+ [false tokens]}
+ tokens)
parts (: (Maybe [Code (List Code) (Maybe Code) Code])
- ("lux case" tokens'
- {(#Cons [_ (#Form (#Cons name args))] (#Cons type (#Cons body #Nil)))
+ ({(#Cons [_ (#Form (#Cons name args))] (#Cons type (#Cons body #Nil)))
(#Some name args (#Some type) body)
(#Cons name (#Cons type (#Cons body #Nil)))
@@ -3012,21 +2997,21 @@
(#Some name #Nil #None body)
_
- #None}))]
- ("lux case" parts
- {(#Some name args ?type body)
- (let' [body' ("lux case" args
- {#Nil
+ #None}
+ tokens'))]
+ ({(#Some name args ?type body)
+ (let' [body' ({#Nil
body
_
- (` (function' (~ name) [(~+ args)] (~ body)))})
- body'' ("lux case" ?type
- {(#Some type)
+ (` (function' (~ name) [(~+ args)] (~ body)))}
+ args)
+ body'' ({(#Some type)
(` (: (~ type) (~ body')))
#None
- body'})]
+ body'}
+ ?type)]
(return (list (` ("lux def" (~ name) (~ body'')
[(~ cursor-code)
(#.Record (~ (if export?
@@ -3034,7 +3019,8 @@
(tag$ ["lux" "Nil"]))))])))))
#None
- (fail "Wrong syntax for def'")})))
+ (fail "Wrong syntax for def'")}
+ parts)))
(def:' (rejoin-pair pair)
(-> [Code Code] (List Code))
@@ -3043,8 +3029,7 @@
(def:' (code-to-text code)
(-> Code Text)
- ("lux case" code
- {[_ (#Bool value)]
+ ({[_ (#Bool value)]
(bool/encode value)
[_ (#Nat value)]
@@ -3088,16 +3073,16 @@
[_ (#Record kvs)]
($_ text/compose "{" (|> kvs
- (list/map (function' [kv] ("lux case" kv {[k v] ($_ text/compose (code-to-text k) " " (code-to-text v))})))
+ (list/map (function' [kv] ({[k v] ($_ text/compose (code-to-text k) " " (code-to-text v))}
+ kv)))
(interpose " ")
list/reverse
(list/fold text/compose "")) "}")}
- ))
+ code))
(def:' (expander branches)
(-> (List Code) (Meta (List Code)))
- ("lux case" branches
- {(#Cons [_ (#Form (#Cons [_ (#Symbol macro-name)] macro-args))]
+ ({(#Cons [_ (#Form (#Cons [_ (#Symbol macro-name)] macro-args))]
(#Cons body
branches'))
(do Monad<Meta>
@@ -3125,7 +3110,8 @@
(list/map code-to-text)
(interpose " ")
list/reverse
- (list/fold text/compose ""))))}))
+ (list/fold text/compose ""))))}
+ branches))
(macro:' #export (case tokens)
(list [(tag$ ["lux" "doc"])
@@ -3137,14 +3123,14 @@
_
#None)")])
- ("lux case" tokens
- {(#Cons value branches)
+ ({(#Cons value branches)
(do Monad<Meta>
[expansion (expander branches)]
- (wrap (list (` ("lux case" (~ value) (~ (record$ (as-pairs expansion))))))))
+ (wrap (list (` ((~ (record$ (as-pairs expansion))) (~ value))))))
_
- (fail "Wrong syntax for case")}))
+ (fail "Wrong syntax for case")}
+ tokens))
(macro:' #export (^ tokens)
(list [(tag$ ["lux" "doc"])
@@ -3229,7 +3215,7 @@
(function' [lr body']
(let' [[l r] lr]
(if (symbol? l)
- (` ("lux case" (~ r) {(~ l) (~ body')}))
+ (` ({(~ l) (~ body')} (~ r)))
(` (case (~ r) (~ l) (~ body')))))))
body)
list
@@ -4650,7 +4636,7 @@
(wrap enhanced-target))))
target
(zip2 tags members))]
- (wrap (` ("lux case" (~ (symbol$ source)) {(~ pattern) (~ enhanced-target)})))))))
+ (wrap (` ({(~ pattern) (~ enhanced-target)} (~ (symbol$ source)))))))))
name tags&members body)]
(wrap (list full-body)))))
@@ -4718,7 +4704,7 @@
g!output
g!_)]))
(zip2 tags (enumerate members))))]
- (return (list (` ("lux case" (~ record) {(~ pattern) (~ g!output)})))))
+ (return (list (` ({(~ pattern) (~ g!output)} (~ record))))))
_
(fail "get@ can only use records.")))
@@ -5065,7 +5051,7 @@
value
r-var)]))
pattern'))]
- (return (list (` ("lux case" (~ record) {(~ pattern) (~ output)}))))))
+ (return (list (` ({(~ pattern) (~ output)} (~ record)))))))
_
(fail "set@ can only use records.")))
@@ -5155,7 +5141,7 @@
(` ((~ fun) (~ r-var)))
r-var)]))
pattern'))]
- (return (list (` ("lux case" (~ record) {(~ pattern) (~ output)}))))))
+ (return (list (` ({(~ pattern) (~ output)} (~ record)))))))
_
(fail "update@ can only use records.")))
@@ -5815,18 +5801,18 @@
expected get-expected-type
g!temp (gensym "temp")]
(let [output (list g!temp
- (` ("lux case" ("lux check" (#.Apply (~ (type-to-code expected)) Maybe)
- (case (~ g!temp)
- (~+ (multi-level-case$ g!temp [mlc body]))
-
- (~ g!temp)
- #.None))
- {(#Some (~ g!temp))
+ (` ({(#Some (~ g!temp))
(~ g!temp)
#None
(case (~ g!temp)
- (~+ next-branches))})))]
+ (~+ next-branches))}
+ ("lux check" (#.Apply (~ (type-to-code expected)) Maybe)
+ (case (~ g!temp)
+ (~+ (multi-level-case$ g!temp [mlc body]))
+
+ (~ g!temp)
+ #.None)))))]
(wrap output)))
_
diff --git a/stdlib/source/lux/control/comonad.lux b/stdlib/source/lux/control/comonad.lux
index 833a01c57..95f31a523 100644
--- a/stdlib/source/lux/control/comonad.lux
+++ b/stdlib/source/lux/control/comonad.lux
@@ -49,11 +49,11 @@
))))
body
(list.reverse (list.as-pairs bindings)))]
- (#.Right [state (#.Cons (` ("lux case" (~ comonad)
- {(~' @)
- ("lux case" (~' @)
- {{#functor {#F.map (~ g!map)} #unwrap (~' unwrap) #split (~ g!split)}
- (~ body')})}))
+ (#.Right [state (#.Cons (` ({(~' @)
+ ({{#functor {#F.map (~ g!map)} #unwrap (~' unwrap) #split (~ g!split)}
+ (~ body')}
+ (~' @))}
+ (~ comonad)))
#.Nil)]))
(#.Left "'be' bindings must have an even number of parts."))
diff --git a/stdlib/source/lux/control/monad.lux b/stdlib/source/lux/control/monad.lux
index 736296920..bc0d3dfc8 100644
--- a/stdlib/source/lux/control/monad.lux
+++ b/stdlib/source/lux/control/monad.lux
@@ -78,13 +78,13 @@
))))
body
(reverse (as-pairs bindings)))]
- (#.Right [state (#.Cons (` ("lux case" (~ monad)
- {(~' @)
- ("lux case" (~' @)
- {{#..functor {#functor.map (~ g!map)}
+ (#.Right [state (#.Cons (` ({(~' @)
+ ({{#..functor {#functor.map (~ g!map)}
#..wrap (~' wrap)
#..join (~ g!join)}
- (~ body')})}))
+ (~ body')}
+ (~' @))}
+ (~ monad)))
#.Nil)]))
(#.Left "'do' bindings must have an even number of parts."))
diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux
index 6628cb81d..108ab2db9 100644
--- a/stdlib/source/lux/host.jvm.lux
+++ b/stdlib/source/lux/host.jvm.lux
@@ -1423,12 +1423,12 @@
"=>"
"YOLO")}
(with-gensyms [g!value]
- (wrap (list (` ("lux case" (~ expr)
- {(#.Some (~ g!value))
+ (wrap (list (` ({(#.Some (~ g!value))
(~ g!value)
#.None
- ("jvm object null")}))))))
+ ("jvm object null")}
+ (~ expr)))))))
(syntax: #export (try expr)
{#.doc (doc "Covers the expression in a try-catch block."
diff --git a/stdlib/source/lux/macro/syntax.lux b/stdlib/source/lux/macro/syntax.lux
index 3b0efaa8a..5739886ea 100644
--- a/stdlib/source/lux/macro/syntax.lux
+++ b/stdlib/source/lux/macro/syntax.lux
@@ -255,18 +255,18 @@
(list)))]]
(wrap (list (` (macro: (~+ export-ast) ((~ (code.symbol ["" name])) (~ g!tokens) (~ g!state))
(~ meta)
- ("lux case" (..run (~ g!tokens)
- (: (..Syntax (Meta (List Code)))
- ((~! do) (~! p.Monad<Parser>)
- [(~+ (join-pairs vars+parsers))]
- ((~' wrap) ((~! do) (~! macro.Monad<Meta>)
- []
- (~ body))))))
- {(#error.Success (~ g!body))
+ ({(#error.Success (~ g!body))
((~ g!body) (~ g!state))
(#error.Error (~ g!error))
- (#error.Error ((~! text.join-with) ": " (list (~ error-msg) (~ g!error))))})))))))
+ (#error.Error ((~! text.join-with) ": " (list (~ error-msg) (~ g!error))))}
+ (..run (~ g!tokens)
+ (: (..Syntax (Meta (List Code)))
+ ((~! do) (~! p.Monad<Parser>)
+ [(~+ (join-pairs vars+parsers))]
+ ((~' wrap) ((~! do) (~! macro.Monad<Meta>)
+ []
+ (~ body)))))))))))))
_
(macro.fail "Wrong syntax for syntax:"))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-25 09:26:43 +0000