diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/lux.lux | 830 | ||||
| -rw-r--r-- | stdlib/source/lux/control/comonad.lux | 10 | ||||
| -rw-r--r-- | stdlib/source/lux/control/monad.lux | 10 | ||||
| -rw-r--r-- | stdlib/source/lux/host.jvm.lux | 6 | ||||
| -rw-r--r-- | stdlib/source/lux/macro/syntax.lux | 18 |
5 files changed, 430 insertions, 444 deletions
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:")))) |