aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux.lux
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux.lux428
1 files changed, 199 insertions, 229 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index b7de70c5d..334632272 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -1635,7 +1635,7 @@
($' m a)
($' m b)))))))
-(def:''' Monad<Maybe>
+(def:''' maybe-monad
#Nil
($' Monad Maybe)
{#wrap
@@ -1647,7 +1647,7 @@
(#Some a) (f a)}
ma))})
-(def:''' Monad<Meta>
+(def:''' meta-monad
#Nil
($' Monad Meta)
{#wrap
@@ -1852,17 +1852,17 @@
(return (tag$ ["lux" "Nil"]))
(#Cons lastI inits)
- (do Monad<Meta>
+ (do meta-monad
[lastO ({[_ (#Form (#Cons [[_ (#Identifier ["" "~+"])] (#Cons [spliced #Nil])]))]
(let' [[[_module-name _ _] _] spliced]
(wrap spliced))
_
- (do Monad<Meta>
+ (do meta-monad
[lastO (untemplate lastI)]
(wrap (form$ (list (tag$ ["lux" "Cons"]) (tuple$ (list lastO (tag$ ["lux" "Nil"])))))))}
lastI)]
- (monad/fold Monad<Meta>
+ (monad/fold meta-monad
(function' [leftI rightO]
({[_ (#Form (#Cons [[_ (#Identifier ["" "~+"])] (#Cons [spliced #Nil])]))]
(let' [[[_module-name _ _] _] spliced]
@@ -1871,7 +1871,7 @@
rightO))))
_
- (do Monad<Meta>
+ (do meta-monad
[leftO (untemplate leftI)]
(wrap (form$ (list (tag$ ["lux" "Cons"]) (tuple$ (list leftO rightO))))))}
leftI))
@@ -1879,8 +1879,8 @@
inits))}
(list/reverse elems))
#0
- (do Monad<Meta>
- [=elems (monad/map Monad<Meta> untemplate elems)]
+ (do meta-monad
+ [=elems (monad/map meta-monad untemplate elems)]
(wrap (untemplate-list =elems)))}
replace?))
@@ -1923,7 +1923,7 @@
(return (wrap-meta (form$ (list (tag$ ["lux" "Tag"]) (tuple$ (list (text$ module') (text$ name))))))))
[#1 [_ (#Identifier [module name])]]
- (do Monad<Meta>
+ (do meta-monad
[real-name ({""
(if (text/= "" subst)
(wrap [module name])
@@ -1942,7 +1942,7 @@
(return unquoted)
[#1 [_ (#Form (#Cons [[_ (#Identifier ["" "~!"])] (#Cons [dependent #Nil])]))]]
- (do Monad<Meta>
+ (do meta-monad
[independent (untemplate replace? subst dependent)]
(wrap (wrap-meta (form$ (list (tag$ ["lux" "Form"])
(untemplate-list (list (untemplate-text "lux in-module")
@@ -1953,24 +1953,24 @@
(untemplate #0 subst keep-quoted)
[_ [meta (#Form elems)]]
- (do Monad<Meta>
+ (do meta-monad
[output (splice replace? (untemplate replace? subst) elems)
#let [[_ output'] (wrap-meta (form$ (list (tag$ ["lux" "Form"]) output)))]]
(wrap [meta output']))
[_ [meta (#Tuple elems)]]
- (do Monad<Meta>
+ (do meta-monad
[output (splice replace? (untemplate replace? subst) elems)
#let [[_ output'] (wrap-meta (form$ (list (tag$ ["lux" "Tuple"]) output)))]]
(wrap [meta output']))
[_ [_ (#Record fields)]]
- (do Monad<Meta>
- [=fields (monad/map Monad<Meta>
+ (do meta-monad
+ [=fields (monad/map meta-monad
("lux check" (-> (& Code Code) ($' Meta Code))
(function' [kv]
(let' [[k v] kv]
- (do Monad<Meta>
+ (do meta-monad
[=k (untemplate replace? subst k)
=v (untemplate replace? subst v)]
(wrap (tuple$ (list =k =v)))))))
@@ -2016,7 +2016,7 @@
"## All unprefixed macros will receive their parent module's prefix if imported; otherwise will receive the prefix of the module on which the quasi-quote is being used." __paragraph
"(` (def: (~ name) (function ((~' _) (~+ args)) (~ body))))"))])
({(#Cons template #Nil)
- (do Monad<Meta>
+ (do meta-monad
[current-module current-module-name
=template (untemplate #1 current-module template)]
(wrap (list (form$ (list (text$ "lux check")
@@ -2033,7 +2033,7 @@
"## Unhygienic quasi-quotation as a macro. Unquote (~) and unquote-splice (~+) must also be used as forms." __paragraph
"(`' (def: (~ name) (function (_ (~+ args)) (~ body))))"))])
({(#Cons template #Nil)
- (do Monad<Meta>
+ (do meta-monad
[=template (untemplate #1 "" template)]
(wrap (list (form$ (list (text$ "lux check") (identifier$ ["lux" "Code"]) =template)))))
@@ -2047,7 +2047,7 @@
"## Quotation as a macro." __paragraph
"(' YOLO)"))])
({(#Cons template #Nil)
- (do Monad<Meta>
+ (do meta-monad
[=template (untemplate #0 "" template)]
(wrap (list (form$ (list (text$ "lux check") (identifier$ ["lux" "Code"]) =template)))))
@@ -2278,8 +2278,8 @@
_
(fail "Wrong syntax for do-template")}
- [(monad/map Monad<Maybe> get-short bindings)
- (monad/map Monad<Maybe> tuple->list data)])
+ [(monad/map maybe-monad get-short bindings)
+ (monad/map maybe-monad tuple->list data)])
_
(fail "Wrong syntax for do-template")}
@@ -2621,7 +2621,7 @@
(-> ($' List (& Text Module))
Text Text Text
($' Maybe Macro))
- (do Monad<Maybe>
+ (do maybe-monad
[$module (get module modules)
gdef (let' [{#module-hash _ #module-aliases _ #definitions bindings #imports _ #tags tags #types types #module-annotations _ #module-state _} ("lux check" Module $module)]
(get name bindings))]
@@ -2650,7 +2650,7 @@
#Nil
(-> Name ($' Meta Name))
({["" name]
- (do Monad<Meta>
+ (do meta-monad
[module-name current-module-name]
(wrap [module-name name]))
@@ -2661,7 +2661,7 @@
(def:''' (find-macro full-name)
#Nil
(-> Name ($' Meta ($' Maybe Macro)))
- (do Monad<Meta>
+ (do meta-monad
[current-module current-module-name]
(let' [[module name] full-name]
(function' [state]
@@ -2676,7 +2676,7 @@
(def:''' (macro? name)
#Nil
(-> Name ($' Meta Bit))
- (do Monad<Meta>
+ (do meta-monad
[name (normalize name)
output (find-macro name)]
(wrap ({(#Some _) #1
@@ -2707,7 +2707,7 @@
#Nil
(-> Code ($' Meta ($' List Code)))
({[_ (#Form (#Cons [_ (#Identifier macro-name)] args))]
- (do Monad<Meta>
+ (do meta-monad
[macro-name' (normalize macro-name)
?macro (find-macro macro-name')]
({(#Some macro)
@@ -2725,13 +2725,13 @@
#Nil
(-> Code ($' Meta ($' List Code)))
({[_ (#Form (#Cons [_ (#Identifier macro-name)] args))]
- (do Monad<Meta>
+ (do meta-monad
[macro-name' (normalize macro-name)
?macro (find-macro macro-name')]
({(#Some macro)
- (do Monad<Meta>
+ (do meta-monad
[expansion (macro args)
- expansion' (monad/map Monad<Meta> macro-expand expansion)]
+ expansion' (monad/map meta-monad macro-expand expansion)]
(wrap (list/join expansion')))
#None
@@ -2746,37 +2746,37 @@
#Nil
(-> Code ($' Meta ($' List Code)))
({[_ (#Form (#Cons [_ (#Identifier macro-name)] args))]
- (do Monad<Meta>
+ (do meta-monad
[macro-name' (normalize macro-name)
?macro (find-macro macro-name')]
({(#Some macro)
- (do Monad<Meta>
+ (do meta-monad
[expansion (macro args)
- expansion' (monad/map Monad<Meta> macro-expand-all expansion)]
+ expansion' (monad/map meta-monad macro-expand-all expansion)]
(wrap (list/join expansion')))
#None
- (do Monad<Meta>
- [args' (monad/map Monad<Meta> macro-expand-all args)]
+ (do meta-monad
+ [args' (monad/map meta-monad macro-expand-all args)]
(wrap (list (form$ (#Cons (identifier$ macro-name) (list/join args'))))))}
?macro))
[_ (#Form members)]
- (do Monad<Meta>
- [members' (monad/map Monad<Meta> macro-expand-all members)]
+ (do meta-monad
+ [members' (monad/map meta-monad macro-expand-all members)]
(wrap (list (form$ (list/join members')))))
[_ (#Tuple members)]
- (do Monad<Meta>
- [members' (monad/map Monad<Meta> macro-expand-all members)]
+ (do meta-monad
+ [members' (monad/map meta-monad macro-expand-all members)]
(wrap (list (tuple$ (list/join members')))))
[_ (#Record pairs)]
- (do Monad<Meta>
- [pairs' (monad/map Monad<Meta>
+ (do meta-monad
+ [pairs' (monad/map meta-monad
(function' [kv]
(let' [[key val] kv]
- (do Monad<Meta>
+ (do meta-monad
[val' (macro-expand-all val)]
({(#Cons val'' #Nil)
(return [key val''])
@@ -2825,7 +2825,7 @@
"## Takes a type expression and returns it's representation as data-structure." __paragraph
"(type (All [a] (Maybe (List a))))"))])
({(#Cons type #Nil)
- (do Monad<Meta>
+ (do meta-monad
[type+ (macro-expand-all type)]
({(#Cons type' #Nil)
(wrap (list (walk-type type')))
@@ -2882,8 +2882,8 @@
#Nil
(-> ($' List Code) ($' Meta (& Code ($' Maybe ($' List Text)))))
({(#Cons [_ (#Record pairs)] #Nil)
- (do Monad<Meta>
- [members (monad/map Monad<Meta>
+ (do meta-monad
+ [members (monad/map meta-monad
(: (-> [Code Code] (Meta [Text Code]))
(function' [pair]
({[[_ (#Tag "" member-name)] member-type]
@@ -2908,8 +2908,8 @@
type)
(#Cons case cases)
- (do Monad<Meta>
- [members (monad/map Monad<Meta>
+ (do meta-monad
+ [members (monad/map meta-monad
(: (-> Code (Meta [Text Code]))
(function' [case]
({[_ (#Tag "" member-name)]
@@ -3093,25 +3093,25 @@
({(#Cons [_ (#Form (#Cons [_ (#Identifier macro-name)] macro-args))]
(#Cons body
branches'))
- (do Monad<Meta>
+ (do meta-monad
[??? (macro? macro-name)]
(if ???
- (do Monad<Meta>
+ (do meta-monad
[init-expansion (macro-expand-once (form$ (list& (identifier$ macro-name) (form$ macro-args) body branches')))]
(expander init-expansion))
- (do Monad<Meta>
+ (do meta-monad
[sub-expansion (expander branches')]
(wrap (list& (form$ (list& (identifier$ macro-name) macro-args))
body
sub-expansion)))))
(#Cons pattern (#Cons body branches'))
- (do Monad<Meta>
+ (do meta-monad
[sub-expansion (expander branches')]
(wrap (list& pattern body sub-expansion)))
#Nil
- (do Monad<Meta> [] (wrap (list)))
+ (do meta-monad [] (wrap (list)))
_
(fail ($_ text/compose "'lux.case' expects an even number of tokens: " (|> branches
@@ -3132,7 +3132,7 @@
" " "_" ..new-line
" " "#None)"))])
({(#Cons value branches)
- (do Monad<Meta>
+ (do meta-monad
[expansion (expander branches)]
(wrap (list (` ((~ (record$ (as-pairs expansion))) (~ value))))))
@@ -3153,7 +3153,7 @@
" #None)"))])
(case tokens
(#Cons [_ (#Form (#Cons pattern #Nil))] (#Cons body branches))
- (do Monad<Meta>
+ (do meta-monad
[pattern+ (macro-expand-all pattern)]
(case pattern+
(#Cons pattern' #Nil)
@@ -3514,11 +3514,11 @@
#None))]
(case ?parts
(#Some name args meta sigs)
- (do Monad<Meta>
+ (do meta-monad
[name+ (normalize name)
- sigs' (monad/map Monad<Meta> macro-expand sigs)
+ sigs' (monad/map meta-monad macro-expand sigs)
members (: (Meta (List [Text Code]))
- (monad/map Monad<Meta>
+ (monad/map meta-monad
(: (-> Code (Meta [Text Code]))
(function (_ token)
(case token
@@ -3723,7 +3723,7 @@
(#Some (beta-reduce (list& type-fn param env) body))
(#Apply A F)
- (do Monad<Maybe>
+ (do maybe-monad
[type-fn* (apply-type F A)]
(apply-type type-fn* param))
@@ -3765,7 +3765,7 @@
(#Some (flatten-tuple type))
(#Apply arg func)
- (do Monad<Maybe>
+ (do maybe-monad
[output (apply-type func arg)]
(resolve-struct-type output))
@@ -3800,13 +3800,13 @@
(def: get-current-module
(Meta Module)
- (do Monad<Meta>
+ (do meta-monad
[module-name current-module-name]
(find-module module-name)))
(def: (resolve-tag [module name])
(-> Name (Meta [Nat (List Name) Bit Type]))
- (do Monad<Meta>
+ (do meta-monad
[=module (find-module module)
#let [{#module-hash _ #module-aliases _ #definitions bindings #imports _ #tags tags-table #types types #module-annotations _ #module-state _} =module]]
(case (get name tags-table)
@@ -3829,7 +3829,7 @@
(resolve-type-tags body)
(#Named [module name] unnamed)
- (do Monad<Meta>
+ (do meta-monad
[=module (find-module module)
#let [{#module-hash _ #module-aliases _ #definitions bindings #imports _ #tags tags #types types #module-annotations _ #module-state _} =module]]
(case (get name types)
@@ -3863,8 +3863,8 @@
(macro: #export (structure tokens)
{#.doc "Not meant to be used directly. Prefer 'structure:'."}
- (do Monad<Meta>
- [tokens' (monad/map Monad<Meta> macro-expand tokens)
+ (do meta-monad
+ [tokens' (monad/map meta-monad macro-expand tokens)
struct-type get-expected-type
tags+type (resolve-type-tags struct-type)
tags (: (Meta (List Name))
@@ -3877,7 +3877,7 @@
#let [tag-mappings (: (List [Text Code])
(list/map (function (_ tag) [(second tag) (tag$ tag)])
tags))]
- members (monad/map Monad<Meta>
+ members (monad/map meta-monad
(: (-> Code (Meta [Code Code]))
(function (_ token)
(case token
@@ -3909,8 +3909,8 @@
(macro: #export (structure: tokens)
{#.doc (text$ ($_ "lux text concat"
"## Definition of structures ala ML." ..new-line
- "(structure: #export Ord<Int> (Ord Int)" ..new-line
- " (def: eq Equivalence<Int>)" ..new-line
+ "(structure: #export order (Order Int)" ..new-line
+ " (def: &equivalence equivalence)" ..new-line
" (def: (< test subject)" ..new-line
" (lux.i/< test subject))" ..new-line
" (def: (<= test subject)" ..new-line
@@ -3940,47 +3940,17 @@
#None))]
(case ?parts
(#Some [name args type meta definitions])
- (case (case name
- [_ (#Identifier ["" "_"])]
- (case type
- (^ [_ (#Form (list& [_ (#Identifier [_ sig-name])] sig-args))])
- (case (: (Maybe (List Text))
- (monad/map Monad<Maybe>
- (function (_ sa)
- (case sa
- [_ (#Identifier [_ arg-name])]
- (#Some arg-name)
+ (let [usage (case args
+ #Nil
+ name
- _
- #None))
- sig-args))
- (^ (#Some params))
- (#Some (identifier$ ["" ($_ text/compose sig-name "<" (|> params (interpose ",") (text/join-with "")) ">")]))
-
- _
- #None)
-
- _
- #None)
-
- _
- (#Some name)
- )
- (#Some name)
- (let [usage (case args
- #Nil
- name
-
- _
- (` ((~ name) (~+ args))))]
- (return (list (` (..def: (~+ (export exported?)) (~ usage)
- (~ (meta-code-merge (` {#.struct? #1})
- meta))
- (~ type)
- (structure (~+ definitions)))))))
-
- #None
- (fail "Cannot infer name, so struct must have a name other than '_'!"))
+ _
+ (` ((~ name) (~+ args))))]
+ (return (list (` (..def: (~+ (export exported?)) (~ usage)
+ (~ (meta-code-merge (` {#.struct? #1})
+ meta))
+ (~ type)
+ (structure (~+ definitions)))))))
#None
(fail "Wrong syntax for structure:"))))
@@ -4022,7 +3992,7 @@
#None))]
(case parts
(#Some name args meta type-codes)
- (do Monad<Meta>
+ (do meta-monad
[type+tags?? (unfold-type-def type-codes)
module-name current-module-name]
(let [type-name (identifier$ ["" name])
@@ -4100,7 +4070,7 @@
(def: (extract-defs defs)
(-> (List Code) (Meta (List Text)))
- (monad/map Monad<Meta>
+ (monad/map meta-monad
(: (-> Code (Meta Text))
(function (_ def)
(case def
@@ -4116,13 +4086,13 @@
(case tokens
(^or (^ (list& [_ (#Form (list& [_ (#Tag ["" "+"])] defs))] tokens'))
(^ (list& [_ (#Form (list& [_ (#Tag ["" "only"])] defs))] tokens')))
- (do Monad<Meta>
+ (do meta-monad
[defs' (extract-defs defs)]
(return [(#Only defs') tokens']))
(^or (^ (list& [_ (#Form (list& [_ (#Tag ["" "-"])] defs))] tokens'))
(^ (list& [_ (#Form (list& [_ (#Tag ["" "exclude"])] defs))] tokens')))
- (do Monad<Meta>
+ (do meta-monad
[defs' (extract-defs defs)]
(return [(#Exclude defs') tokens']))
@@ -4140,8 +4110,8 @@
(return [#.Nil #.Nil])
(^ (list& [_ (#Form (list& [_ (#Text prefix)] structs))] parts'))
- (do Monad<Meta>
- [structs' (monad/map Monad<Meta>
+ (do meta-monad
+ [structs' (monad/map meta-monad
(function (_ struct)
(case struct
[_ (#Identifier ["" struct-name])]
@@ -4165,7 +4135,7 @@
(def: (split-with token sample)
(-> Text Text (Maybe [Text Text]))
- (do ..Monad<Maybe>
+ (do ..maybe-monad
[index (..index-of token sample)
#let [[pre post'] (split! index sample)
[_ post] (split! ("lux text size" token) post')]]
@@ -4259,14 +4229,14 @@
(def: (parse-imports nested? relative-root imports)
(-> Bit Text (List Code) (Meta (List Importation)))
- (do Monad<Meta>
- [imports' (monad/map Monad<Meta>
+ (do meta-monad
+ [imports' (monad/map meta-monad
(: (-> Code (Meta (List Importation)))
(function (_ token)
(case token
## Simple
[_ (#Identifier ["" m-name])]
- (do Monad<Meta>
+ (do meta-monad
[m-name (clean-module nested? relative-root m-name)]
(wrap (list {#import-name m-name
#import-alias #None
@@ -4275,7 +4245,7 @@
## Nested
(^ [_ (#Tuple (list& [_ (#Identifier ["" m-name])] extra))])
- (do Monad<Meta>
+ (do meta-monad
[import-name (clean-module nested? relative-root m-name)
referral+extra (parse-referrals extra)
#let [[referral extra] referral+extra]
@@ -4291,7 +4261,7 @@
sub-imports))))
(^ [_ (#Tuple (list& [_ (#Text alias)] [_ (#Identifier ["" m-name])] extra))])
- (do Monad<Meta>
+ (do meta-monad
[import-name (clean-module nested? relative-root m-name)
referral+extra (parse-referrals extra)
#let [[referral extra] referral+extra]
@@ -4308,25 +4278,25 @@
(^ [_ (#Record (list [[_ (#Tuple (list [_ (#Nat alteration)]
[_ (#Tag ["" domain])]))]
parallel-tree]))])
- (do Monad<Meta>
+ (do meta-monad
[parallel-imports (parse-imports nested? relative-root (list parallel-tree))]
(wrap (list/map (alter-domain alteration domain) parallel-imports)))
(^ [_ (#Record (list [[_ (#Nat alteration)]
parallel-tree]))])
- (do Monad<Meta>
+ (do meta-monad
[parallel-imports (parse-imports nested? relative-root (list parallel-tree))]
(wrap (list/map (alter-domain alteration "") parallel-imports)))
(^ [_ (#Record (list [[_ (#Tag ["" domain])]
parallel-tree]))])
- (do Monad<Meta>
+ (do meta-monad
[parallel-imports (parse-imports nested? relative-root (list parallel-tree))
#let [alteration (list/size (text/split-all-with ..module-separator domain))]]
(wrap (list/map (alter-domain alteration domain) parallel-imports)))
_
- (do Monad<Meta>
+ (do meta-monad
[current-module current-module-name]
(fail (text/compose "Wrong syntax for import @ " current-module))))))
imports)]
@@ -4460,7 +4430,7 @@
(def: (find-type full-name)
(-> Name (Meta Type))
- (do Monad<Meta>
+ (do meta-monad
[#let [[module name] full-name]
current-module current-module-name]
(function (_ compiler)
@@ -4569,12 +4539,12 @@
" (range' <= succ from to))"))}
(case tokens
(^ (list& [_ (#Form (list [_ (#Text alias)]))] body branches))
- (do Monad<Meta>
+ (do meta-monad
[g!temp (gensym "temp")]
(wrap (list& g!temp (` (..^open (~ g!temp) (~ (text$ alias)) (~ body))) branches)))
(^ (list [_ (#Identifier name)] [_ (#Text alias)] body))
- (do Monad<Meta>
+ (do meta-monad
[init-type (find-type name)
struct-evidence (resolve-type-tags init-type)]
(case struct-evidence
@@ -4582,17 +4552,17 @@
(fail (text/compose "Can only 'open' structs: " (type/encode init-type)))
(#Some tags&members)
- (do Monad<Meta>
+ (do meta-monad
[full-body ((: (-> Name [(List Name) (List Type)] Code (Meta Code))
(function (recur source [tags members] target)
(let [pattern (record$ (list/map (function (_ [t-module t-name])
[(tag$ [t-module t-name])
(identifier$ ["" (de-alias t-name alias)])])
tags))]
- (do Monad<Meta>
- [enhanced-target (monad/fold Monad<Meta>
+ (do meta-monad
+ [enhanced-target (monad/fold meta-monad
(function (_ [[_ m-name] m-type] enhanced-target)
- (do Monad<Meta>
+ (do meta-monad
[m-structure (resolve-type-tags m-type)]
(case m-structure
(#Some m-tags&members)
@@ -4659,7 +4629,7 @@
" (getter my-record))"))}
(case tokens
(^ (list [_ (#Tag slot')] record))
- (do Monad<Meta>
+ (do meta-monad
[slot (normalize slot')
output (resolve-tag slot)
#let [[idx tags exported? type] output]
@@ -4687,7 +4657,7 @@
slots)))
(^ (list selector))
- (do Monad<Meta>
+ (do meta-monad
[g!_ (gensym "_")
g!record (gensym "record")]
(wrap (list (` (function ((~ g!_) (~ g!record)) (..get@ (~ selector) (~ g!record)))))))
@@ -4697,13 +4667,13 @@
(def: (open-field alias [module name] source type)
(-> Text Name Code Type (Meta (List Code)))
- (do Monad<Meta>
+ (do meta-monad
[output (resolve-type-tags type)
#let [source+ (` (get@ (~ (tag$ [module name])) (~ source)))]]
(case output
(#Some [tags members])
- (do Monad<Meta>
- [decls' (monad/map Monad<Meta>
+ (do meta-monad
+ [decls' (monad/map meta-monad
(: (-> [Name Type] (Meta (List Code)))
(function (_ [sname stype]) (open-field alias sname source+ stype)))
(zip2 tags members))]
@@ -4719,27 +4689,27 @@
"## Opens a structure and generates a definition for each of its members (including nested members)."
__paragraph
"## For example:" ..new-line
- "(open: ''i:.'' Number<Int>)"
+ "(open: ''i:.'' number)"
__paragraph
"## Will generate:" ..new-line
- "(def: i:+ (:: Number<Int> +))" ..new-line
- "(def: i:- (:: Number<Int> -))" ..new-line
- "(def: i:* (:: Number<Int> *))" ..new-line
+ "(def: i:+ (:: number +))" ..new-line
+ "(def: i:- (:: number -))" ..new-line
+ "(def: i:* (:: number *))" ..new-line
"..."))}
(case tokens
(^ (list [_ (#Text alias)] struct))
(case struct
[_ (#Identifier struct-name)]
- (do Monad<Meta>
+ (do meta-monad
[struct-type (find-type struct-name)
output (resolve-type-tags struct-type)
#let [source (identifier$ struct-name)]]
(case output
(#Some [tags members])
- (do Monad<Meta>
- [decls' (monad/map Monad<Meta> (: (-> [Name Type] (Meta (List Code)))
- (function (_ [sname stype])
- (open-field alias sname source stype)))
+ (do meta-monad
+ [decls' (monad/map meta-monad (: (-> [Name Type] (Meta (List Code)))
+ (function (_ [sname stype])
+ (open-field alias sname source stype)))
(zip2 tags members))]
(return (list/join decls')))
@@ -4747,7 +4717,7 @@
(fail (text/compose "Can only 'open:' structs: " (type/encode struct-type)))))
_
- (do Monad<Meta>
+ (do meta-monad
[g!struct (gensym "struct")]
(return (list (` ("lux def" (~ g!struct) (~ struct)
[(~ cursor-code) (#.Record #Nil)]))
@@ -4762,7 +4732,7 @@
"(|>> (list/map int/encode) (interpose '' '') (fold text/compose ''''))" ..new-line
"## =>" ..new-line
"(function (_ <arg>) (fold text/compose '''' (interpose '' '' (list/map int/encode <arg>))))"))}
- (do Monad<Meta>
+ (do meta-monad
[g!_ (gensym "_")
g!arg (gensym "arg")]
(return (list (` (function ((~ g!_) (~ g!arg)) (|> (~ g!arg) (~+ tokens))))))))
@@ -4773,21 +4743,21 @@
"(<<| (fold text/compose '''') (interpose '' '') (list/map int/encode))" ..new-line
"## =>" ..new-line
"(function (_ <arg>) (fold text/compose '''' (interpose '' '' (list/map int/encode <arg>))))"))}
- (do Monad<Meta>
+ (do meta-monad
[g!_ (gensym "_")
g!arg (gensym "arg")]
(return (list (` (function ((~ g!_) (~ g!arg)) (<| (~+ tokens) (~ g!arg))))))))
(def: (imported-by? import-name module-name)
(-> Text Text (Meta Bit))
- (do Monad<Meta>
+ (do meta-monad
[module (find-module module-name)
#let [{#module-hash _ #module-aliases _ #definitions _ #imports imports #tags _ #types _ #module-annotations _ #module-state _} module]]
(wrap (is-member? imports import-name))))
(def: (read-refer module-name options)
(-> Text (List Code) (Meta Refer))
- (do Monad<Meta>
+ (do meta-monad
[referral+options (parse-referrals options)
#let [[referral options] referral+options]
openings+options (parse-openings options)
@@ -4795,7 +4765,7 @@
current-module current-module-name
#let [test-referrals (: (-> Text (List Text) (List Text) (Meta (List Any)))
(function (_ module-name all-defs referred-defs)
- (monad/map Monad<Meta>
+ (monad/map meta-monad
(: (-> Text (Meta Any))
(function (_ _def)
(if (is-member? all-defs _def)
@@ -4816,11 +4786,11 @@
(def: (write-refer module-name [r-defs r-opens])
(-> Text Refer (Meta (List Code)))
- (do Monad<Meta>
+ (do meta-monad
[current-module current-module-name
#let [test-referrals (: (-> Text (List Text) (List Text) (Meta (List Any)))
(function (_ module-name all-defs referred-defs)
- (monad/map Monad<Meta>
+ (monad/map meta-monad
(: (-> Text (Meta Any))
(function (_ _def)
(if (is-member? all-defs _def)
@@ -4832,13 +4802,13 @@
(exported-definitions module-name)
(#Only +defs)
- (do Monad<Meta>
+ (do meta-monad
[*defs (exported-definitions module-name)
_ (test-referrals module-name *defs +defs)]
(wrap +defs))
(#Exclude -defs)
- (do Monad<Meta>
+ (do meta-monad
[*defs (exported-definitions module-name)
_ (test-referrals module-name *defs -defs)]
(wrap (filter (|>> (is-member? -defs) not) *defs)))
@@ -4866,7 +4836,7 @@
(macro: #export (refer tokens)
(case tokens
(^ (list& [_ (#Text module-name)] options))
- (do Monad<Meta>
+ (do meta-monad
[=refer (read-refer module-name options)]
(write-refer module-name =refer))
@@ -4908,12 +4878,12 @@
" [''M'' monad #*]]" ..new-line
" [data" ..new-line
" maybe" ..new-line
- " [''.'' name (''name/.'' Codec<Text,Name>)]]" ..new-line
+ " [''.'' name (''name/.'' codec)]]" ..new-line
" [macro" ..new-line
" code]]" ..new-line
" [//" ..new-line
- " [type (''.'' Equivalence<Type>)]])"))}
- (do Monad<Meta>
+ " [type (''.'' equivalence)]])"))}
+ (do meta-monad
[#let [[_meta _imports] (: [(List [Code Code]) (List Code)]
(case tokens
(^ (list& [_ (#Record _meta)] _imports))
@@ -4940,10 +4910,10 @@
(macro: #export (:: tokens)
{#.doc (text$ ($_ "lux text concat"
"## Allows accessing the value of a structure's member." ..new-line
- "(:: Codec<Text,Int> encode)"
+ "(:: codec encode)"
__paragraph
"## Also allows using that value as a function." ..new-line
- "(:: Codec<Text,Int> encode +123)"))}
+ "(:: codec encode +123)"))}
(case tokens
(^ (list struct [_ (#Identifier member)]))
(return (list (` (let [(^open ".") (~ struct)] (~ (identifier$ member))))))
@@ -4967,17 +4937,17 @@
"(let [setter (set@ [#foo #bar #baz])] (setter value my-record))"))}
(case tokens
(^ (list [_ (#Tag slot')] value record))
- (do Monad<Meta>
+ (do meta-monad
[slot (normalize slot')
output (resolve-tag slot)
#let [[idx tags exported? type] output]]
(case (resolve-struct-type type)
(#Some members)
- (do Monad<Meta>
- [pattern' (monad/map Monad<Meta>
+ (do meta-monad
+ [pattern' (monad/map meta-monad
(: (-> [Name [Nat Type]] (Meta [Name Nat Code]))
(function (_ [r-slot-name [r-idx r-type]])
- (do Monad<Meta>
+ (do meta-monad
[g!slot (gensym "")]
(return [r-slot-name r-idx g!slot]))))
(zip2 tags (enumerate members)))]
@@ -5004,8 +4974,8 @@
(fail "Wrong syntax for set@")
_
- (do Monad<Meta>
- [bindings (monad/map Monad<Meta>
+ (do meta-monad
+ [bindings (monad/map meta-monad
(: (-> Code (Meta Code))
(function (_ _) (gensym "temp")))
slots)
@@ -5026,13 +4996,13 @@
(~ update-expr)))))))
(^ (list selector value))
- (do Monad<Meta>
+ (do meta-monad
[g!_ (gensym "_")
g!record (gensym "record")]
(wrap (list (` (function ((~ g!_) (~ g!record)) (..set@ (~ selector) (~ value) (~ g!record)))))))
(^ (list selector))
- (do Monad<Meta>
+ (do meta-monad
[g!_ (gensym "_")
g!value (gensym "value")
g!record (gensym "record")]
@@ -5054,17 +5024,17 @@
"(let [updater (update@ [#foo #bar #baz])] (updater func my-record))"))}
(case tokens
(^ (list [_ (#Tag slot')] fun record))
- (do Monad<Meta>
+ (do meta-monad
[slot (normalize slot')
output (resolve-tag slot)
#let [[idx tags exported? type] output]]
(case (resolve-struct-type type)
(#Some members)
- (do Monad<Meta>
- [pattern' (monad/map Monad<Meta>
+ (do meta-monad
+ [pattern' (monad/map meta-monad
(: (-> [Name [Nat Type]] (Meta [Name Nat Code]))
(function (_ [r-slot-name [r-idx r-type]])
- (do Monad<Meta>
+ (do meta-monad
[g!slot (gensym "")]
(return [r-slot-name r-idx g!slot]))))
(zip2 tags (enumerate members)))]
@@ -5091,7 +5061,7 @@
(fail "Wrong syntax for update@")
_
- (do Monad<Meta>
+ (do meta-monad
[g!record (gensym "record")
g!temp (gensym "temp")]
(wrap (list (` (let [(~ g!record) (~ record)
@@ -5099,13 +5069,13 @@
(set@ [(~+ slots)] ((~ fun) (~ g!temp)) (~ g!record))))))))
(^ (list selector fun))
- (do Monad<Meta>
+ (do meta-monad
[g!_ (gensym "_")
g!record (gensym "record")]
(wrap (list (` (function ((~ g!_) (~ g!record)) (..update@ (~ selector) (~ fun) (~ g!record)))))))
(^ (list selector))
- (do Monad<Meta>
+ (do meta-monad
[g!_ (gensym "_")
g!fun (gensym "fun")
g!record (gensym "record")]
@@ -5154,9 +5124,9 @@
[_ (#Form data)]
branches))
(case (: (Maybe (List Code))
- (do Monad<Maybe>
- [bindings' (monad/map Monad<Maybe> get-short bindings)
- data' (monad/map Monad<Maybe> tuple->list data)]
+ (do maybe-monad
+ [bindings' (monad/map maybe-monad get-short bindings)
+ data' (monad/map maybe-monad tuple->list data)]
(if (every? (n/= (list/size bindings')) (list/map list/size data'))
(let [apply (: (-> RepEnv (List Code))
(function (_ env) (list/map (apply-template env) templates)))]
@@ -5426,20 +5396,20 @@
vars (list/map first pairs)
inits (list/map second pairs)]
(if (every? identifier? inits)
- (do Monad<Meta>
+ (do meta-monad
[inits' (: (Meta (List Name))
- (case (monad/map Monad<Maybe> get-name inits)
+ (case (monad/map maybe-monad get-name inits)
(#Some inits') (return inits')
#None (fail "Wrong syntax for loop")))
- init-types (monad/map Monad<Meta> find-type inits')
+ init-types (monad/map meta-monad find-type inits')
expected get-expected-type]
(return (list (` (("lux check" (-> (~+ (list/map type-to-code init-types))
(~ (type-to-code expected)))
(function ((~ name) (~+ vars))
(~ body)))
(~+ inits))))))
- (do Monad<Meta>
- [aliases (monad/map Monad<Meta>
+ (do meta-monad
+ [aliases (monad/map meta-monad
(: (-> Code (Meta Code))
(function (_ _) (gensym "")))
inits)]
@@ -5457,12 +5427,12 @@
(f foo bar baz)))}
(case tokens
(^ (list& [_ (#Form (list [_ (#Tuple (list& hslot' tslots'))]))] body branches))
- (do Monad<Meta>
+ (do meta-monad
[slots (: (Meta [Name (List Name)])
(case (: (Maybe [Name (List Name)])
- (do Monad<Maybe>
+ (do maybe-monad
[hslot (get-tag hslot')
- tslots (monad/map Monad<Maybe> get-tag tslots')]
+ tslots (monad/map maybe-monad get-tag tslots')]
(wrap [hslot tslots])))
(#Some slots)
(return slots)
@@ -5471,7 +5441,7 @@
(fail "Wrong syntax for ^slots")))
#let [[hslot tslots] slots]
hslot (normalize hslot)
- tslots (monad/map Monad<Meta> normalize tslots)
+ tslots (monad/map meta-monad normalize tslots)
output (resolve-tag hslot)
g!_ (gensym "_")
#let [[idx tags exported? type] output
@@ -5504,18 +5474,18 @@
(^template [<tag> <ctor>]
[_ (<tag> elems)]
- (do Monad<Maybe>
- [placements (monad/map Monad<Maybe> (place-tokens label tokens) elems)]
+ (do maybe-monad
+ [placements (monad/map maybe-monad (place-tokens label tokens) elems)]
(wrap (list (<ctor> (list/join placements))))))
([#Tuple tuple$]
[#Form form$])
[_ (#Record pairs)]
- (do Monad<Maybe>
- [=pairs (monad/map Monad<Maybe>
+ (do maybe-monad
+ [=pairs (monad/map maybe-monad
(: (-> [Code Code] (Maybe [Code Code]))
(function (_ [slot value])
- (do Monad<Maybe>
+ (do maybe-monad
[slot' (place-tokens label tokens slot)
value' (place-tokens label tokens value)]
(case [slot' value']
@@ -5537,7 +5507,7 @@
[<tests> (do-template [<expr> <text> <pattern>]
[(compare <pattern> <expr>)
(compare <text> (:: Code/encode encode <expr>))
- (compare #1 (:: Equivalence<Code> = <expr> <expr>))]
+ (compare #1 (:: equivalence = <expr> <expr>))]
[(bit #1) "#1" [_ (#.Bit #1)]]
[(bit #0) "#0" [_ (#.Bit #0)]]
@@ -5557,7 +5527,7 @@
(^ (list& [_ (#Tuple bindings)] bodies))
(case bindings
(^ (list& [_ (#Identifier ["" var-name])] macro-expr bindings'))
- (do Monad<Meta>
+ (do meta-monad
[expansion (macro-expand-once macro-expr)]
(case (place-tokens var-name expansion (` (.with-expansions
[(~+ bindings')]
@@ -5598,7 +5568,7 @@
(def: (anti-quote-def name)
(-> Name (Meta Code))
- (do Monad<Meta>
+ (do meta-monad
[type+value (find-def-value name)
#let [[type value] type+value]]
(case (flatten-alias type)
@@ -5620,38 +5590,38 @@
(case token
[_ (#Identifier [def-prefix def-name])]
(if (text/= "" def-prefix)
- (do Monad<Meta>
+ (do meta-monad
[current-module current-module-name]
(anti-quote-def [current-module def-name]))
(anti-quote-def [def-prefix def-name]))
(^template [<tag>]
[meta (<tag> parts)]
- (do Monad<Meta>
- [=parts (monad/map Monad<Meta> anti-quote parts)]
+ (do meta-monad
+ [=parts (monad/map meta-monad anti-quote parts)]
(wrap [meta (<tag> =parts)])))
([#Form]
[#Tuple])
[meta (#Record pairs)]
- (do Monad<Meta>
- [=pairs (monad/map Monad<Meta>
+ (do meta-monad
+ [=pairs (monad/map meta-monad
(: (-> [Code Code] (Meta [Code Code]))
(function (_ [slot value])
- (do Monad<Meta>
+ (do meta-monad
[=value (anti-quote value)]
(wrap [slot =value]))))
pairs)]
(wrap [meta (#Record =pairs)]))
_
- (:: Monad<Meta> return token)
+ (:: meta-monad return token)
))
(macro: #export (static tokens)
(case tokens
(^ (list pattern))
- (do Monad<Meta>
+ (do meta-monad
[pattern' (anti-quote pattern)]
(wrap (list pattern')))
@@ -5678,8 +5648,8 @@
(fail "Multi-level patterns cannot be empty.")
(#Cons init extras)
- (do Monad<Meta>
- [extras' (monad/map Monad<Meta> case-level^ extras)]
+ (do meta-monad
+ [extras' (monad/map meta-monad case-level^ extras)]
(wrap [init extras']))))
(def: (multi-level-case$ g!_ [[init-pattern levels] body])
@@ -5716,7 +5686,7 @@
(#.Left (format "Static part " (%t static) " does not match URI: " uri))))}
(case tokens
(^ (list& [_meta (#Form levels)] body next-branches))
- (do Monad<Meta>
+ (do meta-monad
[mlc (multi-level-case^ levels)
expected get-expected-type
g!temp (gensym "temp")]
@@ -5804,7 +5774,7 @@
list)))}
(case tokens
(^ (list [_ (#Nat idx)]))
- (do Monad<Meta>
+ (do meta-monad
[stvs get-scope-type-vars]
(case (list-at idx (list/reverse stvs))
(#Some var-id)
@@ -5864,7 +5834,7 @@
(: Dinosaur (:assume (list +1 +2 +3))))}
(case tokens
(^ (list expr))
- (do Monad<Meta>
+ (do meta-monad
[type get-expected-type]
(wrap (list (` ("lux coerce" (~ (type-to-code type)) (~ expr))))))
@@ -5899,12 +5869,12 @@
Int)}
(case tokens
(^ (list [_ (#Identifier var-name)]))
- (do Monad<Meta>
+ (do meta-monad
[var-type (find-type var-name)]
(wrap (list (type-to-code var-type))))
(^ (list expression))
- (do Monad<Meta>
+ (do meta-monad
[g!temp (gensym "g!temp")]
(wrap (list (` (let [(~ g!temp) (~ expression)]
(..:of (~ g!temp)))))))
@@ -5916,8 +5886,8 @@
(-> (List Code) (Meta [[Text (List Text)] (List Code)]))
(case tokens
(^ (list& [_ (#Form (list& [_ (#Identifier ["" name])] args'))] tokens'))
- (do Monad<Meta>
- [args (monad/map Monad<Meta>
+ (do meta-monad
+ [args (monad/map meta-monad
(function (_ arg')
(case arg'
[_ (#Identifier ["" arg-name])]
@@ -5977,7 +5947,7 @@
"For simple macros that do not need any fancy features."
(template: (square x)
(i/* x x)))}
- (do Monad<Meta>
+ (do meta-monad
[#let [[export? tokens] (export^ tokens)]
name+args|tokens (parse-complex-declaration tokens)
#let [[[name args] tokens] name+args|tokens]
@@ -6051,7 +6021,7 @@
))
(macro: #export (for tokens)
- (do Monad<Meta>
+ (do meta-monad
[target target]
(case tokens
(^ (list [_ (#Record options)]))
@@ -6081,23 +6051,23 @@
(-> Code (Meta [(List [Code Code]) Code]))
(case code
(^ [ann (#Form (list [_ (#Identifier ["" "~~"])] expansion))])
- (do Monad<Meta>
+ (do meta-monad
[g!expansion (gensym "g!expansion")]
(wrap [(list [g!expansion expansion]) g!expansion]))
(^template [<tag>]
[ann (<tag> parts)]
- (do Monad<Meta>
- [=parts (monad/map Monad<Meta> label-code parts)]
+ (do meta-monad
+ [=parts (monad/map meta-monad label-code parts)]
(wrap [(list/fold list/compose (list) (list/map left =parts))
[ann (<tag> (list/map right =parts))]])))
([#Form] [#Tuple])
[ann (#Record kvs)]
- (do Monad<Meta>
- [=kvs (monad/map Monad<Meta>
+ (do meta-monad
+ [=kvs (monad/map meta-monad
(function (_ [key val])
- (do Monad<Meta>
+ (do meta-monad
[=key (label-code key)
=val (label-code val)
#let [[key-labels key-labelled] =key
@@ -6113,7 +6083,7 @@
(macro: #export (`` tokens)
(case tokens
(^ (list raw))
- (do Monad<Meta>
+ (do meta-monad
[=raw (label-code raw)
#let [[labels labelled] =raw]]
(wrap (list (` (with-expansions [(~+ (|> labels
@@ -6143,7 +6113,7 @@
(case pattern
(^template [<tag> <name> <gen>]
[_ (<tag> value)]
- (do Monad<Meta>
+ (do meta-monad
[g!meta (gensym "g!meta")]
(wrap (` [(~ g!meta) (<tag> (~ (<gen> value)))]))))
([#Bit "Bit" bit$]
@@ -6156,10 +6126,10 @@
[#Identifier "Identifier" name$])
[_ (#Record fields)]
- (do Monad<Meta>
- [=fields (monad/map Monad<Meta>
+ (do meta-monad
+ [=fields (monad/map meta-monad
(function (_ [key value])
- (do Monad<Meta>
+ (do meta-monad
[=key (untemplate-pattern key)
=value (untemplate-pattern value)]
(wrap (` [(~ =key) (~ =value)]))))
@@ -6178,14 +6148,14 @@
(case (list/reverse elems)
(#Cons [_ (#Form (#Cons [[_ (#Identifier ["" "~+"])] (#Cons [spliced #Nil])]))]
inits)
- (do Monad<Meta>
- [=inits (monad/map Monad<Meta> untemplate-pattern (list/reverse inits))
+ (do meta-monad
+ [=inits (monad/map meta-monad untemplate-pattern (list/reverse inits))
g!meta (gensym "g!meta")]
(wrap (` [(~ g!meta) (<tag> (~ (untemplate-list& spliced =inits)))])))
_
- (do Monad<Meta>
- [=elems (monad/map Monad<Meta> untemplate-pattern elems)
+ (do meta-monad
+ [=elems (monad/map meta-monad untemplate-pattern elems)
g!meta (gensym "g!meta")]
(wrap (` [(~ g!meta) (<tag> (~ (untemplate-list =elems)))])))))
([#Tuple] [#Form])
@@ -6194,12 +6164,12 @@
(macro: #export (^code tokens)
(case tokens
(^ (list& [_meta (#Form (list template))] body branches))
- (do Monad<Meta>
+ (do meta-monad
[pattern (untemplate-pattern template)]
(wrap (list& pattern body branches)))
(^ (list template))
- (do Monad<Meta>
+ (do meta-monad
[pattern (untemplate-pattern template)]
(wrap (list pattern)))