aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
authorEduardo Julian2019-04-17 19:37:20 -0400
committerEduardo Julian2019-04-17 19:37:20 -0400
commit7abfef5e4a61fb8b98fdbcedff0732442e50677b (patch)
tree89cba2652f0359331406bb795fc0d8097bb793f6 /stdlib
parent797e49a906d850d28d94986c127a8e432ea89e40 (diff)
- Made the "open:" and "^open" macros not generate record-patterns, and thus not need (or impose a need on) tags.
- The "do" macro for monads also doesn't need tags anymore.
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux.lux100
-rw-r--r--stdlib/source/lux/abstract/enum.lux1
-rw-r--r--stdlib/source/lux/abstract/monad.lux4
-rw-r--r--stdlib/source/lux/control/exception.lux3
-rw-r--r--stdlib/source/lux/control/parser.lux1
-rw-r--r--stdlib/source/lux/data/collection/dictionary.lux3
-rw-r--r--stdlib/source/lux/data/name.lux1
-rw-r--r--stdlib/source/lux/data/text/lexer.lux44
-rw-r--r--stdlib/source/lux/macro.lux80
-rw-r--r--stdlib/source/lux/macro/code.lux20
-rw-r--r--stdlib/source/lux/macro/syntax.lux60
-rw-r--r--stdlib/source/lux/macro/syntax/common/reader.lux14
-rw-r--r--stdlib/source/lux/macro/syntax/common/writer.lux8
13 files changed, 171 insertions, 168 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index 1a3d71480..6fe8100ba 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -447,6 +447,11 @@
([_ name] (_ann (#Tag name))))
[dummy-cursor (#Record #Nil)])
+("lux def" local-tag$
+ ("lux check" (#Function Text Code)
+ ([_ name] (_ann (#Tag ["" name]))))
+ [dummy-cursor (#Record #Nil)])
+
("lux def" form$
("lux check" (#Function (#Apply Code List) Code)
([_ tokens] (_ann (#Form tokens))))
@@ -1008,7 +1013,7 @@
(#Cons [_ (#Tag ["" "export"])] (#Cons [_ (#Form (#Cons name args))] (#Cons body #Nil)))
(return (#Cons (form$ (#Cons (identifier$ ["lux" "def:''"])
- (#Cons (tag$ ["" "export"])
+ (#Cons (local-tag$ "export")
(#Cons (form$ (#Cons name args))
(#Cons (with-macro-meta (tag$ ["lux" "Nil"]))
(#Cons (identifier$ ["lux" "Macro"])
@@ -1019,7 +1024,7 @@
(#Cons [_ (#Tag ["" "export"])] (#Cons [_ (#Form (#Cons name args))] (#Cons meta-data (#Cons body #Nil))))
(return (#Cons (form$ (#Cons (identifier$ ["lux" "def:''"])
- (#Cons (tag$ ["" "export"])
+ (#Cons (local-tag$ "export")
(#Cons (form$ (#Cons name args))
(#Cons (with-macro-meta meta-data)
(#Cons (identifier$ ["lux" "Macro"])
@@ -1424,10 +1429,10 @@
(fail "function' requires a non-empty arguments tuple.")
(#Cons [harg targs])
- (return (list (form$ (list (tuple$ (list (identifier$ ["" name])
+ (return (list (form$ (list (tuple$ (list (local-identifier$ name)
harg))
(list@fold (function'' [arg body']
- (form$ (list (tuple$ (list (identifier$ ["" ""])
+ (form$ (list (tuple$ (list (local-identifier$ "")
arg))
body')))
body
@@ -1674,8 +1679,8 @@
(macro:' (do tokens)
({(#Cons monad (#Cons [_ (#Tuple bindings)] (#Cons body #Nil)))
- (let' [g!wrap (identifier$ ["" "wrap"])
- g!bind (identifier$ ["" " bind "])
+ (let' [g!wrap (local-identifier$ "wrap")
+ g!bind (local-identifier$ " bind ")
body' (list@fold ("lux check" (-> (& Code Code) Code Code)
(function' [binding body']
(let' [[var value] binding]
@@ -1684,7 +1689,7 @@
_
(form$ (list g!bind
- (form$ (list (tuple$ (list (identifier$ ["" ""]) var)) body'))
+ (form$ (list (tuple$ (list (local-identifier$ "") var)) body'))
value))}
var))))
body
@@ -2948,7 +2953,7 @@
#seed (n/+ 1 seed) #expected expected
#cursor cursor #extensions extensions
#scope-type-vars scope-type-vars}
- (identifier$ ["" ($_ text@compose "__gensym__" prefix (nat@encode seed))]))}
+ (local-identifier$ ($_ text@compose "__gensym__" prefix (nat@encode seed))))}
state))
(macro:' #export (Rec tokens)
@@ -2976,7 +2981,7 @@
" " "(log! ''#3'')" ..new-line
"''YOLO'')"))])
({(#Cons value actions)
- (let' [dummy (identifier$ ["" ""])]
+ (let' [dummy (local-identifier$ "")]
(return (list (list@fold ("lux check" (-> Code Code Code)
(function' [pre post] (` ({(~ dummy) (~ post)}
(~ pre)))))
@@ -3250,8 +3255,8 @@
_
#None))
(#Some g!name head tail body)
- (let [g!blank (identifier$ ["" ""])
- g!name (identifier$ ["" g!name])
+ (let [g!blank (local-identifier$ "")
+ g!name (local-identifier$ g!name)
body+ (list@fold (: (-> Code Code Code)
(function' [arg body']
(if (identifier? arg)
@@ -3535,7 +3540,7 @@
def-name (identifier$ name)
sig-type (record$ (list@map (: (-> [Text Code] [Code Code])
(function (_ [m-name m-type])
- [(tag$ ["" m-name]) m-type]))
+ [(local-tag$ m-name) m-type]))
members))
sig-meta (meta-code-merge (` {#.sig? #1})
meta)
@@ -3998,7 +4003,7 @@
(do meta-monad
[type+tags?? (unfold-type-def type-codes)
module-name current-module-name]
- (let [type-name (identifier$ ["" name])
+ (let [type-name (local-identifier$ name)
[type tags??] type+tags??
type-meta (: Code
(case tags??
@@ -4011,8 +4016,8 @@
type' (: (Maybe Code)
(if rec?
(if (empty? args)
- (let [g!param (identifier$ ["" ""])
- prime-name (identifier$ ["" name])
+ (let [g!param (local-identifier$ "")
+ prime-name (local-identifier$ name)
type+ (replace-syntax (list [name (` ((~ prime-name) .Nothing))]) type)]
(#Some (` ((All (~ prime-name) [(~ g!param)] (~ type+))
.Nothing))))
@@ -4572,25 +4577,25 @@
(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))]
+ (let [locals (list@map (function (_ [t-module t-name])
+ ["" (de-alias "" t-name alias)])
+ tags)
+ pattern (tuple$ (list@map identifier$ locals))]
(do meta-monad
[enhanced-target (monad/fold meta-monad
- (function (_ [[_ m-name] m-type] enhanced-target)
+ (function (_ [m-local m-type] enhanced-target)
(do meta-monad
[m-structure (resolve-type-tags m-type)]
(case m-structure
(#Some m-tags&members)
- (recur ["" (de-alias "" m-name alias)]
+ (recur m-local
m-tags&members
enhanced-target)
#None
(wrap enhanced-target))))
target
- (zip2 tags members))]
+ (zip2 locals members))]
(wrap (` ({(~ pattern) (~ enhanced-target)} (~ (identifier$ source)))))))))
name tags&members body)]
(wrap (list full-body)))))
@@ -4682,22 +4687,32 @@
_
(fail "Wrong syntax for get@")))
-(def: (open-field alias [module name] source type)
- (-> Text Name Code Type (Meta (List Code)))
+(def: (open-field alias tags my-tag-index [module short] source type)
+ (-> Text (List Name) Nat Name Code Type (Meta (List Code)))
(do meta-monad
[output (resolve-type-tags type)
- #let [source+ (` (get@ (~ (tag$ [module name])) (~ source)))]]
+ g!_ (gensym "g!_")
+ #let [g!output (local-identifier$ short)
+ pattern (|> tags
+ enumerate
+ (list@map (function (_ [tag-idx tag])
+ (if (n/= my-tag-index tag-idx)
+ g!output
+ g!_)))
+ tuple$)
+ source+ (` ({(~ pattern) (~ g!output)} (~ source)))]]
(case output
- (#Some [tags members])
+ (#Some [tags' members'])
(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))]
+ (: (-> [Nat Name Type] (Meta (List Code)))
+ (function (_ [sub-tag-index sname stype])
+ (open-field alias tags' sub-tag-index sname source+ stype)))
+ (enumerate (zip2 tags' members')))]
(return (list@join decls')))
_
- (return (list (` ("lux def" (~ (identifier$ ["" (de-alias "" name alias)]))
+ (return (list (` ("lux def" (~ (local-identifier$ (de-alias "" short alias)))
(~ source+)
[(~ cursor-code) (#.Record #Nil)])))))))
@@ -4724,10 +4739,10 @@
(case output
(#Some [tags members])
(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))]
+ [decls' (monad@map meta-monad (: (-> [Nat Name Type] (Meta (List Code)))
+ (function (_ [tag-index sname stype])
+ (open-field alias tags tag-index sname source stype)))
+ (enumerate (zip2 tags members)))]
(return (list@join decls')))
_
@@ -4837,7 +4852,7 @@
(wrap (list)))
#let [defs (list@map (: (-> Text Code)
(function (_ def)
- (` ("lux def alias" (~ (identifier$ ["" def])) (~ (identifier$ [module-name def]))))))
+ (` ("lux def alias" (~ (local-identifier$ def)) (~ (identifier$ [module-name def]))))))
defs')
openings (join-map (: (-> Openings (List Code))
(function (_ [alias structs])
@@ -5400,7 +5415,7 @@
(#.Some [name bindings body])
(^ (list [_ (#Tuple bindings)] body))
- (#.Some [(identifier$ ["" "recur"]) bindings body])
+ (#.Some [(local-identifier$ "recur") bindings body])
_
#.None)]
@@ -5460,7 +5475,8 @@
g!_ (gensym "_")
#let [[idx tags exported? type] output
slot-pairings (list@map (: (-> Name [Text Code])
- (function (_ [module name]) [name (identifier$ ["" name])]))
+ (function (_ [module name])
+ [name (local-identifier$ name)]))
(list& hslot tslots))
pattern (record$ (list@map (: (-> Name [Code Code])
(function (_ [module name])
@@ -5819,7 +5835,7 @@
(to-list set))))}
(case tokens
(^ (list& [_meta (#Form (list [_ (#Identifier ["" name])] pattern))] body branches))
- (let [g!whole (identifier$ ["" name])]
+ (let [g!whole (local-identifier$ name)]
(return (list& g!whole
(` (case (~ g!whole) (~ pattern) (~ body)))
branches)))
@@ -5834,7 +5850,7 @@
(foo value)))}
(case tokens
(^ (list& [_meta (#Form (list [_ (#Identifier ["" name])] [_ (#Tuple steps)]))] body branches))
- (let [g!name (identifier$ ["" name])]
+ (let [g!name (local-identifier$ name)]
(return (list& g!name
(` (let [(~ g!name) (|> (~ g!name) (~+ steps))]
(~ body)))
@@ -5974,14 +5990,14 @@
g!compiler (gensym "compiler")
g!_ (gensym "_")
#let [rep-env (list@map (function (_ arg)
- [arg (` ((~' ~) (~ (identifier$ ["" arg]))))])
+ [arg (` ((~' ~) (~ (local-identifier$ arg))))])
args)]
this-module current-module-name]
(wrap (list (` (macro: (~+ (export export?))
- ((~ (identifier$ ["" name])) (~ g!tokens) (~ g!compiler))
+ ((~ (local-identifier$ name)) (~ g!tokens) (~ g!compiler))
(~ anns)
(case (~ g!tokens)
- (^ (list (~+ (list@map (|>> [""] identifier$) args))))
+ (^ (list (~+ (list@map local-identifier$ args))))
(#.Right [(~ g!compiler)
(list (~+ (list@map (function (_ template)
(` (`' (~ (replace-syntax rep-env template)))))
diff --git a/stdlib/source/lux/abstract/enum.lux b/stdlib/source/lux/abstract/enum.lux
index 07d7f0ec5..5bbb7df38 100644
--- a/stdlib/source/lux/abstract/enum.lux
+++ b/stdlib/source/lux/abstract/enum.lux
@@ -1,7 +1,6 @@
(.module:
[lux #*]
[//
- [equivalence (#+)]
["." order]])
(signature: #export (Enum e)
diff --git a/stdlib/source/lux/abstract/monad.lux b/stdlib/source/lux/abstract/monad.lux
index 0772d8c98..a0ee9b5aa 100644
--- a/stdlib/source/lux/abstract/monad.lux
+++ b/stdlib/source/lux/abstract/monad.lux
@@ -77,9 +77,7 @@
body
(reverse (as-pairs bindings)))]
(#.Right [state (#.Cons (` ({(~' @)
- ({{#..&functor {#functor.map (~ g!map)}
- #..wrap (~' wrap)
- #..join (~ g!join)}
+ ({[(~ g!map) (~' wrap) (~ g!join)]
(~ body')}
(~' @))}
(~ monad)))
diff --git a/stdlib/source/lux/control/exception.lux b/stdlib/source/lux/control/exception.lux
index 72cba8e54..d24277208 100644
--- a/stdlib/source/lux/control/exception.lux
+++ b/stdlib/source/lux/control/exception.lux
@@ -1,9 +1,6 @@
(.module: {#.doc "Exception-handling functionality built on top of the Error type."}
[lux #*
[abstract
- [monoid (#+)]
- [fold (#+)]
- [functor (#+)]
[monad (#+ do)]]
[control
["p" parser]]
diff --git a/stdlib/source/lux/control/parser.lux b/stdlib/source/lux/control/parser.lux
index 0db1d625b..84f63c548 100644
--- a/stdlib/source/lux/control/parser.lux
+++ b/stdlib/source/lux/control/parser.lux
@@ -1,7 +1,6 @@
(.module:
[lux (#- or and not)
[abstract
- [monoid (#+)]
[functor (#+ Functor)]
[apply (#+ Apply)]
[monad (#+ Monad do)]
diff --git a/stdlib/source/lux/data/collection/dictionary.lux b/stdlib/source/lux/data/collection/dictionary.lux
index 2f07ceb3e..bf5c64d43 100644
--- a/stdlib/source/lux/data/collection/dictionary.lux
+++ b/stdlib/source/lux/data/collection/dictionary.lux
@@ -1,9 +1,6 @@
(.module:
[lux #*
[abstract
- [monoid (#+)]
- [fold (#+)]
- [monad (#+)]
[hash (#+ Hash)]
[equivalence (#+ Equivalence)]
[functor (#+ Functor)]]
diff --git a/stdlib/source/lux/data/name.lux b/stdlib/source/lux/data/name.lux
index 3ad96cd84..20aa73d28 100644
--- a/stdlib/source/lux/data/name.lux
+++ b/stdlib/source/lux/data/name.lux
@@ -1,7 +1,6 @@
(.module:
[lux #*
[abstract
- [monoid (#+)]
[equivalence (#+ Equivalence)]
[order (#+ Order)]
[codec (#+ Codec)]
diff --git a/stdlib/source/lux/data/text/lexer.lux b/stdlib/source/lux/data/text/lexer.lux
index 531d2ae64..958011b1c 100644
--- a/stdlib/source/lux/data/text/lexer.lux
+++ b/stdlib/source/lux/data/text/lexer.lux
@@ -1,7 +1,7 @@
(.module:
[lux (#- or and not)
[abstract
- [monad (#+ do Monad)]]
+ [monad (#+ Monad do)]]
[control
["p" parser]
["ex" exception (#+ exception:)]]
@@ -10,12 +10,12 @@
["." maybe]
["." error (#+ Error)]
[number
- ["." nat ("#;." decimal)]]
+ ["." nat ("#@." decimal)]]
[collection
- ["." list ("#;." fold)]]]
+ ["." list ("#@." fold)]]]
[macro
["." code]]]
- ["." // ("#;." monoid)])
+ ["." // ("#@." monoid)])
(type: #export Offset Nat)
@@ -35,8 +35,8 @@
(|> tape (//.split offset) maybe.assume product.right))
(exception: #export (unconsumed-input {offset Offset} {tape Text})
- (ex.report ["Offset" (nat;encode offset)]
- ["Input size" (nat;encode (//.size tape))]
+ (ex.report ["Offset" (nat@encode offset)]
+ ["Input size" (nat@encode (//.size tape))]
["Remaining input" (remaining offset tape)]))
(def: #export (run input lexer)
@@ -60,7 +60,7 @@
(do p.monad
[offset ..offset
slices lexer]
- (wrap (list;fold (function (_ [slice::basis slice::distance]
+ (wrap (list@fold (function (_ [slice::basis slice::distance]
[total::basis total::distance])
[total::basis ("lux i64 +" slice::distance total::distance)])
{#basis offset
@@ -96,7 +96,7 @@
(<any> input)
_
- (#error.Failure "Expected to fail; yet succeeded."))))]
+ (#error.Failure "Expected to fail@ yet succeeded."))))]
[not Text ..any]
[not! Slice ..any!]
@@ -111,10 +111,10 @@
(if (n/= offset where)
(#error.Success [[("lux i64 +" (//.size reference) offset) tape]
[]])
- (#error.Failure ($_ //;compose "Could not match: " (//.encode reference) " @ " (maybe.assume (//.clip' offset tape)))))
+ (#error.Failure ($_ //@compose "Could not match: " (//.encode reference) " @ " (maybe.assume (//.clip' offset tape)))))
_
- (#error.Failure ($_ //;compose "Could not match: " (//.encode reference))))))
+ (#error.Failure ($_ //@compose "Could not match: " (//.encode reference))))))
(def: #export (this? reference)
{#.doc "Lex a text if it matches the given sample."}
@@ -165,14 +165,14 @@
(do p.monad
[char any
#let [char' (maybe.assume (//.nth 0 char))]
- _ (p.assert ($_ //;compose "Character is not within range: " (//.from-code bottom) "-" (//.from-code top))
+ _ (p.assert ($_ //@compose "Character is not within range: " (//.from-code bottom) "-" (//.from-code top))
(.and (n/>= bottom char')
(n/<= top char')))]
(wrap char)))
(template [<name> <bottom> <top> <desc>]
[(def: #export <name>
- {#.doc (code.text ($_ //;compose "Only lex " <desc> " characters."))}
+ {#.doc (code.text ($_ //@compose "Only lex " <desc> " characters."))}
(Lexer Text)
(range (char <bottom>) (char <top>)))]
@@ -202,7 +202,7 @@
(template [<name> <description-modifier> <modifier>]
[(def: #export (<name> options)
- {#.doc (code.text ($_ //;compose "Only lex characters that are" <description-modifier> " part of a piece of text."))}
+ {#.doc (code.text ($_ //@compose "Only lex characters that are" <description-modifier> " part of a piece of text."))}
(-> Text (Lexer Text))
(function (_ [offset tape])
(case (//.nth offset tape)
@@ -210,7 +210,7 @@
(let [output (//.from-code output)]
(if (<modifier> (//.contains? output options))
(#error.Success [[("lux i64 +" 1 offset) tape] output])
- (#error.Failure ($_ //;compose "Character (" output
+ (#error.Failure ($_ //@compose "Character (" output
") is should " <description-modifier>
"be one of: " options))))
@@ -223,7 +223,7 @@
(template [<name> <description-modifier> <modifier>]
[(def: #export (<name> options)
- {#.doc (code.text ($_ //;compose "Only lex characters that are" <description-modifier> " part of a piece of text."))}
+ {#.doc (code.text ($_ //@compose "Only lex characters that are" <description-modifier> " part of a piece of text."))}
(-> Text (Lexer Slice))
(function (_ [offset tape])
(case (//.nth offset tape)
@@ -233,7 +233,7 @@
(#error.Success [[("lux i64 +" 1 offset) tape]
{#basis offset
#distance 1}])
- (#error.Failure ($_ //;compose "Character (" output
+ (#error.Failure ($_ //@compose "Character (" output
") is should " <description-modifier>
"be one of: " options))))
@@ -252,7 +252,7 @@
(#.Some output)
(if (p output)
(#error.Success [[("lux i64 +" 1 offset) tape] (//.from-code output)])
- (#error.Failure ($_ //;compose "Character does not satisfy predicate: " (//.from-code output))))
+ (#error.Failure ($_ //@compose "Character does not satisfy predicate: " (//.from-code output))))
_
(#error.Failure cannot-lex-error))))
@@ -267,7 +267,7 @@
(do p.monad
[=left left
=right right]
- (wrap ($_ //;compose =left =right))))
+ (wrap ($_ //@compose =left =right))))
(def: #export (and! left right)
(-> (Lexer Slice) (Lexer Slice) (Lexer Slice))
@@ -278,7 +278,7 @@
(template [<name> <base> <doc-modifier>]
[(def: #export (<name> lexer)
- {#.doc (code.text ($_ //;compose "Lex " <doc-modifier> " characters as a single continuous text."))}
+ {#.doc (code.text ($_ //@compose "Lex " <doc-modifier> " characters as a single continuous text."))}
(-> (Lexer Text) (Lexer Text))
(|> lexer <base> (:: p.monad map //.concat)))]
@@ -288,7 +288,7 @@
(template [<name> <base> <doc-modifier>]
[(def: #export (<name> lexer)
- {#.doc (code.text ($_ //;compose "Lex " <doc-modifier> " characters as a single continuous text."))}
+ {#.doc (code.text ($_ //@compose "Lex " <doc-modifier> " characters as a single continuous text."))}
(-> (Lexer Slice) (Lexer Slice))
(with-slices (<base> lexer)))]
@@ -298,7 +298,7 @@
(template [<name> <base> <doc-modifier>]
[(def: #export (<name> amount lexer)
- {#.doc (code.text ($_ //;compose "Lex " <doc-modifier> " N characters."))}
+ {#.doc (code.text ($_ //@compose "Lex " <doc-modifier> " N characters."))}
(-> Nat (Lexer Text) (Lexer Text))
(|> lexer (<base> amount) (:: p.monad map //.concat)))]
@@ -309,7 +309,7 @@
(template [<name> <base> <doc-modifier>]
[(def: #export (<name> amount lexer)
- {#.doc (code.text ($_ //;compose "Lex " <doc-modifier> " N characters."))}
+ {#.doc (code.text ($_ //@compose "Lex " <doc-modifier> " N characters."))}
(-> Nat (Lexer Slice) (Lexer Slice))
(with-slices (<base> amount lexer)))]
diff --git a/stdlib/source/lux/macro.lux b/stdlib/source/lux/macro.lux
index a3014c649..b05b0682f 100644
--- a/stdlib/source/lux/macro.lux
+++ b/stdlib/source/lux/macro.lux
@@ -6,14 +6,14 @@
["." monad (#+ Monad do)]]
[data
["." product]
- ["." name ("#;." codec equivalence)]
+ ["." name ("#@." codec equivalence)]
["." maybe]
["." error (#+ Error)]
[number
- ["." nat ("#;." decimal)]]
- ["." text ("#;." monoid equivalence)]
+ ["." nat ("#@." decimal)]]
+ ["." text ("#@." monoid equivalence)]
[collection
- ["." list ("#;." monoid monad)]]]]
+ ["." list ("#@." monoid monad)]]]]
[/
["." code]])
@@ -71,7 +71,7 @@
#.None
(#.Cons [k' v] plist')
- (if (text;= k k')
+ (if (text@= k k')
(#.Some v)
(get k plist'))))
@@ -122,7 +122,7 @@
(#error.Success [compiler module])
_
- (#error.Failure ($_ text;compose "Unknown module: " name)))))
+ (#error.Failure ($_ text@compose "Unknown module: " name)))))
(def: #export current-module-name
(Meta Text)
@@ -151,7 +151,7 @@
(#.Cons [key value] anns')
(case key
[_ (#.Tag tag')]
- (if (name;= tag tag')
+ (if (name@= tag tag')
(#.Some value)
(recur anns'))
@@ -197,7 +197,7 @@
(template [<name> <tag> <desc>]
[(def: #export <name>
- {#.doc (code.text ($_ text;compose "Checks whether a definition is " <desc> "."))}
+ {#.doc (code.text ($_ text@compose "Checks whether a definition is " <desc> "."))}
(-> Code Bit)
(flag-set? (name-of <tag>)))]
@@ -253,9 +253,7 @@
(do maybe.monad
[$module (get module modules)
[def-type def-anns def-value] (: (Maybe Definition) (|> (: Module $module) (get@ #.definitions) (get name)))]
- (if (and (macro? def-anns)
- (or (export? def-anns)
- (text;= module this-module)))
+ (if (macro? def-anns)
(#.Some (:coerce Macro def-value))
(case (get-identifier-ann (name-of #.alias) def-anns)
(#.Some [r-module r-name])
@@ -317,7 +315,7 @@
(do ..monad
[expansion (macro args)
expansion' (monad.map ..monad expand expansion)]
- (wrap (list;join expansion')))
+ (wrap (list@join expansion')))
#.None
(:: ..monad wrap (list syntax))))
@@ -337,23 +335,23 @@
(do ..monad
[expansion (macro args)
expansion' (monad.map ..monad expand-all expansion)]
- (wrap (list;join expansion')))
+ (wrap (list@join expansion')))
#.None
(do ..monad
[parts' (monad.map ..monad expand-all (list& (code.identifier name) args))]
- (wrap (list (code.form (list;join parts')))))))
+ (wrap (list (code.form (list@join parts')))))))
[_ (#.Form (#.Cons [harg targs]))]
(do ..monad
[harg+ (expand-all harg)
targs+ (monad.map ..monad expand-all targs)]
- (wrap (list (code.form (list;compose harg+ (list;join (: (List (List Code)) targs+)))))))
+ (wrap (list (code.form (list@compose harg+ (list@join (: (List (List Code)) targs+)))))))
[_ (#.Tuple members)]
(do ..monad
[members' (monad.map ..monad expand-all members)]
- (wrap (list (code.tuple (list;join members')))))
+ (wrap (list (code.tuple (list@join members')))))
_
(:: ..monad wrap (list syntax))))
@@ -373,7 +371,7 @@
(|> compiler
(get@ #.seed)
(:: nat.decimal encode)
- ($_ text;compose "__gensym__" prefix)
+ ($_ text@compose "__gensym__" prefix)
[""] code.identifier)])))
(def: (get-local-identifier ast)
@@ -383,12 +381,12 @@
(:: ..monad wrap name)
_
- (fail (text;compose "Code is not a local identifier: " (code.to-text ast)))))
+ (fail (text@compose "Code is not a local identifier: " (code.to-text ast)))))
(def: #export wrong-syntax-error
(-> Name Text)
- (|>> name;encode
- (text;compose "Wrong syntax for ")))
+ (|>> name@encode
+ (text@compose "Wrong syntax for ")))
(macro: #export (with-gensyms tokens)
{#.doc (doc "Creates new identifiers and offers them to the body expression."
@@ -404,7 +402,7 @@
(^ (list [_ (#.Tuple identifiers)] body))
(do ..monad
[identifier-names (monad.map @ get-local-identifier identifiers)
- #let [identifier-defs (list;join (list;map (: (-> Text (List Code))
+ #let [identifier-defs (list@join (list@map (: (-> Text (List Code))
(function (_ name) (list (code.identifier ["" name]) (` (gensym (~ (code.text name)))))))
identifier-names))]]
(wrap (list (` ((~! do) (~! ..monad)
@@ -476,7 +474,7 @@
(-> Text (Meta Type))
(function (_ compiler)
(let [test (: (-> [Text [Type Any]] Bit)
- (|>> product.left (text;= name)))]
+ (|>> product.left (text@= name)))]
(case (do maybe.monad
[scope (list.find (function (_ env)
(or (list.any? test (: (List [Text [Type Any]])
@@ -494,7 +492,7 @@
((clean-type var-type) compiler)
#.None
- (#error.Failure ($_ text;compose "Unknown variable: " name))))))
+ (#error.Failure ($_ text@compose "Unknown variable: " name))))))
(def: #export (find-def name)
{#.doc "Looks-up a definition's whole data in the available modules (including the current one)."}
@@ -512,19 +510,19 @@
_
(let [current-module (|> compiler (get@ #.current-module) (maybe.default "???"))
- separator ($_ text;compose text.new-line " ")]
- (#error.Failure ($_ text;compose
- "Unknown definition: " (name;encode name) text.new-line
+ separator ($_ text@compose text.new-line " ")]
+ (#error.Failure ($_ text@compose
+ "Unknown definition: " (name@encode name) text.new-line
" Current module: " current-module text.new-line
(case (get current-module (get@ #.modules compiler))
(#.Some this-module)
- ($_ text;compose
+ ($_ text@compose
" Imports: " (|> this-module (get@ #.imports) (text.join-with separator)) text.new-line
- " Aliases: " (|> this-module (get@ #.module-aliases) (list;map (function (_ [alias real]) ($_ text;compose alias " => " real))) (text.join-with separator)) text.new-line)
+ " Aliases: " (|> this-module (get@ #.module-aliases) (list@map (function (_ [alias real]) ($_ text@compose alias " => " real))) (text.join-with separator)) text.new-line)
_
"")
- " All Known modules: " (|> compiler (get@ #.modules) (list;map product.left) (text.join-with separator)) text.new-line)))))))
+ " All Known modules: " (|> compiler (get@ #.modules) (list@map product.left) (text.join-with separator)) text.new-line)))))))
(def: #export (find-def-type name)
{#.doc "Looks-up a definition's type in the available modules (including the current one)."}
@@ -558,7 +556,7 @@
(-> Text (Meta (List [Text Definition])))
(function (_ compiler)
(case (get module-name (get@ #.modules compiler))
- #.None (#error.Failure ($_ text;compose "Unknown module: " module-name))
+ #.None (#error.Failure ($_ text@compose "Unknown module: " module-name))
(#.Some module) (#error.Success [compiler (get@ #.definitions module)])
)))
@@ -621,14 +619,14 @@
(-> Text Text (Meta Bit))
(do ..monad
[(^slots [#.imports]) (find-module module)]
- (wrap (list.any? (text;= import) imports))))
+ (wrap (list.any? (text@= import) imports))))
(def: #export (imported? import)
(-> Text (Meta Bit))
(let [(^open ".") ..monad]
(|> current-module-name
(map find-module) join
- (map (|>> (get@ #.imports) (list.any? (text;= import)))))))
+ (map (|>> (get@ #.imports) (list.any? (text@= import)))))))
(def: #export (resolve-tag tag)
{#.doc "Given a tag, finds out what is its index, its related tag-list and it's associated type."}
@@ -640,13 +638,13 @@
imported! (..imported? module)]
(case (get name (get@ #.tags =module))
(#.Some [idx tag-list exported? type])
- (if (or (text;= this-module-name module)
+ (if (or (text@= this-module-name module)
(and imported! exported?))
(wrap [idx tag-list type])
- (fail ($_ text;compose "Cannot access tag: " (name;encode tag) " from module " this-module-name)))
+ (fail ($_ text@compose "Cannot access tag: " (name@encode tag) " from module " this-module-name)))
_
- (fail ($_ text;compose "Unknown tag: " (name;encode tag))))))
+ (fail ($_ text@compose "Unknown tag: " (name@encode tag))))))
(def: #export (tag-lists module)
{#.doc "All the tag-lists defined in a module, with their associated types."}
@@ -657,8 +655,8 @@
(wrap (|> (get@ #.types =module)
(list.filter (function (_ [type-name [tag-list exported? type]])
(or exported?
- (text;= this-module-name module))))
- (list;map (function (_ [type-name [tag-list exported? type]])
+ (text@= this-module-name module))))
+ (list@map (function (_ [type-name [tag-list exported? type]])
[tag-list type]))))))
(def: #export locals
@@ -671,8 +669,8 @@
(#.Some scopes)
(#error.Success [compiler
- (list;map (|>> (get@ [#.locals #.mappings])
- (list;map (function (_ [name [type _]])
+ (list@map (|>> (get@ [#.locals #.mappings])
+ (list@map (function (_ [name [type _]])
[name type])))
scopes)]))))
@@ -723,8 +721,8 @@
(do ..monad
[cursor ..cursor
output (<func> token)
- #let [_ (log! ($_ text;compose (name;encode (name-of <macro>)) " @ " (.cursor-description cursor)))
- _ (list;map (|>> code.to-text log!)
+ #let [_ (log! ($_ text@compose (name@encode (name-of <macro>)) " @ " (.cursor-description cursor)))
+ _ (list@map (|>> code.to-text log!)
output)
_ (log! "")]]
(wrap (if omit?
diff --git a/stdlib/source/lux/macro/code.lux b/stdlib/source/lux/macro/code.lux
index ae7ba555c..219bb76e4 100644
--- a/stdlib/source/lux/macro/code.lux
+++ b/stdlib/source/lux/macro/code.lux
@@ -10,9 +10,9 @@
["." int]
["." rev]
["." frac]]
- ["." text ("#;." monoid)]
+ ["." text ("#@." monoid)]
[collection
- ["." list ("#;." functor fold)]]]])
+ ["." list ("#@." functor)]]]])
## (type: (Code' w)
## (#.Bit Bit)
@@ -103,14 +103,14 @@
(text.encode value)
[_ (#.Tag name)]
- (text;compose "#" (:: name.codec encode name))
+ (text@compose "#" (:: name.codec encode name))
(^template [<tag> <open> <close>]
[_ (<tag> members)]
- ($_ text;compose
+ ($_ text@compose
<open>
(|> members
- (list;map to-text)
+ (list@map to-text)
(list.interpose " ")
(text.join-with ""))
<close>))
@@ -118,11 +118,11 @@
[#.Tuple "[" "]"])
[_ (#.Record pairs)]
- ($_ text;compose
+ ($_ text@compose
"{"
(|> pairs
- (list;map (function (_ [left right])
- ($_ text;compose (to-text left) " " (to-text right))))
+ (list@map (function (_ [left right])
+ ($_ text@compose (to-text left) " " (to-text right))))
(list.interpose " ")
(text.join-with ""))
"}")
@@ -136,12 +136,12 @@
(case ast
(^template [<tag>]
[cursor (<tag> parts)]
- [cursor (<tag> (list;map (replace original substitute) parts))])
+ [cursor (<tag> (list@map (replace original substitute) parts))])
([#.Form]
[#.Tuple])
[cursor (#.Record parts)]
- [cursor (#.Record (list;map (function (_ [left right])
+ [cursor (#.Record (list@map (function (_ [left right])
[(replace original substitute left)
(replace original substitute right)])
parts))]
diff --git a/stdlib/source/lux/macro/syntax.lux b/stdlib/source/lux/macro/syntax.lux
index 90d8b0938..bd5372618 100644
--- a/stdlib/source/lux/macro/syntax.lux
+++ b/stdlib/source/lux/macro/syntax.lux
@@ -1,8 +1,8 @@
(.module:
[lux (#- nat int rev)
[abstract
- ["." monad (#+ Monad do)]
- [equivalence (#+ Equivalence)]]
+ [equivalence (#+ Equivalence)]
+ ["." monad (#+ Monad do)]]
[control
["p" parser]]
[data
@@ -15,11 +15,11 @@
["." int]
["." rev]
["." frac]]
- ["." text ("#;." monoid)]
+ ["." text ("#@." monoid)]
[collection
- ["." list ("#;." functor)]]]]
+ ["." list ("#@." functor)]]]]
["." // (#+ with-gensyms)
- ["." code ("#;." equivalence)]])
+ ["." code ("#@." equivalence)]])
(def: (join-pairs pairs)
(All [a] (-> (List [a a]) (List a)))
@@ -33,8 +33,8 @@
(def: (remaining-inputs asts)
(-> (List Code) Text)
- ($_ text;compose text.new-line "Remaining input: "
- (|> asts (list;map code.to-text) (list.interpose " ") (text.join-with ""))))
+ ($_ text@compose text.new-line "Remaining input: "
+ (|> asts (list@map code.to-text) (list.interpose " ") (text.join-with ""))))
(def: #export any
{#.doc "Just returns the next input without applying any logic."}
@@ -46,7 +46,7 @@
(template [<get-name> <type> <tag> <eq> <desc>]
[(def: #export <get-name>
- {#.doc (code.text ($_ text;compose "Parses the next " <desc> " input Code."))}
+ {#.doc (code.text ($_ text@compose "Parses the next " <desc> " input Code."))}
(Syntax <type>)
(function (_ tokens)
(case tokens
@@ -54,7 +54,7 @@
(#error.Success [tokens' x])
_
- (#error.Failure ($_ text;compose "Cannot parse " <desc> (remaining-inputs tokens))))))]
+ (#error.Failure ($_ text@compose "Cannot parse " <desc> (remaining-inputs tokens))))))]
[ bit Bit #.Bit bit.equivalence "bit"]
[ nat Nat #.Nat nat.equivalence "nat"]
@@ -72,7 +72,7 @@
(function (_ tokens)
(case tokens
(#.Cons [token tokens'])
- (let [is-it? (code;= ast token)
+ (let [is-it? (code@= ast token)
remaining (if is-it?
tokens'
tokens)]
@@ -87,9 +87,9 @@
(function (_ tokens)
(case tokens
(#.Cons [token tokens'])
- (if (code;= ast token)
+ (if (code@= ast token)
(#error.Success [tokens' []])
- (#error.Failure ($_ text;compose "Expected a " (code.to-text ast) " but instead got " (code.to-text token)
+ (#error.Failure ($_ text@compose "Expected a " (code.to-text ast) " but instead got " (code.to-text token)
(remaining-inputs tokens))))
_
@@ -97,7 +97,7 @@
(template [<name> <tag> <desc>]
[(def: #export <name>
- {#.doc (code.text ($_ text;compose "Parse a local " <desc> " (a " <desc> " that has no module prefix)."))}
+ {#.doc (code.text ($_ text@compose "Parse a local " <desc> " (a " <desc> " that has no module prefix)."))}
(Syntax Text)
(function (_ tokens)
(case tokens
@@ -105,7 +105,7 @@
(#error.Success [tokens' x])
_
- (#error.Failure ($_ text;compose "Cannot parse local " <desc> (remaining-inputs tokens))))))]
+ (#error.Failure ($_ text@compose "Cannot parse local " <desc> (remaining-inputs tokens))))))]
[local-identifier #.Identifier "identifier"]
[ local-tag #.Tag "tag"]
@@ -113,7 +113,7 @@
(template [<name> <tag> <desc>]
[(def: #export (<name> p)
- {#.doc (code.text ($_ text;compose "Parse inside the contents of a " <desc> " as if they were the input Codes."))}
+ {#.doc (code.text ($_ text@compose "Parse inside the contents of a " <desc> " as if they were the input Codes."))}
(All [a]
(-> (Syntax a) (Syntax a)))
(function (_ tokens)
@@ -121,17 +121,17 @@
(#.Cons [[_ (<tag> members)] tokens'])
(case (p members)
(#error.Success [#.Nil x]) (#error.Success [tokens' x])
- _ (#error.Failure ($_ text;compose "Syntax was expected to fully consume " <desc> (remaining-inputs tokens))))
+ _ (#error.Failure ($_ text@compose "Syntax was expected to fully consume " <desc> (remaining-inputs tokens))))
_
- (#error.Failure ($_ text;compose "Cannot parse " <desc> (remaining-inputs tokens))))))]
+ (#error.Failure ($_ text@compose "Cannot parse " <desc> (remaining-inputs tokens))))))]
[ form #.Form "form"]
[tuple #.Tuple "tuple"]
)
(def: #export (record p)
- {#.doc (code.text ($_ text;compose "Parse inside the contents of a record as if they were the input Codes."))}
+ {#.doc (code.text ($_ text@compose "Parse inside the contents of a record as if they were the input Codes."))}
(All [a]
(-> (Syntax a) (Syntax a)))
(function (_ tokens)
@@ -139,10 +139,10 @@
(#.Cons [[_ (#.Record pairs)] tokens'])
(case (p (join-pairs pairs))
(#error.Success [#.Nil x]) (#error.Success [tokens' x])
- _ (#error.Failure ($_ text;compose "Syntax was expected to fully consume record" (remaining-inputs tokens))))
+ _ (#error.Failure ($_ text@compose "Syntax was expected to fully consume record" (remaining-inputs tokens))))
_
- (#error.Failure ($_ text;compose "Cannot parse record" (remaining-inputs tokens))))))
+ (#error.Failure ($_ text@compose "Cannot parse record" (remaining-inputs tokens))))))
(def: #export end!
{#.doc "Ensures there are no more inputs."}
@@ -150,7 +150,7 @@
(function (_ tokens)
(case tokens
#.Nil (#error.Success [tokens []])
- _ (#error.Failure ($_ text;compose "Expected list of tokens to be empty!" (remaining-inputs tokens))))))
+ _ (#error.Failure ($_ text@compose "Expected list of tokens to be empty!" (remaining-inputs tokens))))))
(def: #export end?
{#.doc "Checks whether there are no more inputs."}
@@ -183,8 +183,8 @@
(#error.Success value)
_
- (#error.Failure (text;compose "Unconsumed inputs: "
- (|> (list;map code.to-text unconsumed)
+ (#error.Failure (text@compose "Unconsumed inputs: "
+ (|> (list@map code.to-text unconsumed)
(text.join-with ", ")))))))
(def: #export (local inputs syntax)
@@ -206,11 +206,11 @@
{interfaces (tuple (some (super-class-decl^ imports class-vars)))}
{constructor-args (constructor-args^ imports class-vars)}
{methods (some (overriden-method-def^ imports))})
- (let [def-code ($_ text;compose "anon-class:"
+ (let [def-code ($_ text@compose "anon-class:"
(spaced (list (super-class-decl$ (maybe.default object-super-class super))
- (with-brackets (spaced (list;map super-class-decl$ interfaces)))
- (with-brackets (spaced (list;map constructor-arg$ constructor-args)))
- (with-brackets (spaced (list;map (method-def$ id) methods))))))]
+ (with-brackets (spaced (list@map super-class-decl$ interfaces)))
+ (with-brackets (spaced (list@map constructor-arg$ constructor-args)))
+ (with-brackets (spaced (list@map (method-def$ id) methods))))))]
(wrap (list (` ((~ (code.text def-code)))))))))}
(let [[exported? tokens] (: [Bit (List Code)]
(case tokens
@@ -258,11 +258,11 @@
(list)))]]
(wrap (list (` (macro: (~+ export-ast) ((~ (code.identifier ["" name])) (~ g!tokens) (~ g!state))
(~ meta)
- ({(#error.Success (~ g!body))
+ ({(#.Right (~ g!body))
((~ g!body) (~ g!state))
- (#error.Failure (~ g!error))
- (#error.Failure ((~! text.join-with) ": " (list (~ error-msg) (~ g!error))))}
+ (#.Left (~ g!error))
+ (#.Left ((~! text.join-with) ": " (list (~ error-msg) (~ g!error))))}
((~! ..run) (~ g!tokens)
(: ((~! ..Syntax) (Meta (List Code)))
((~! do) (~! p.monad)
diff --git a/stdlib/source/lux/macro/syntax/common/reader.lux b/stdlib/source/lux/macro/syntax/common/reader.lux
index 99277857f..7f66a3879 100644
--- a/stdlib/source/lux/macro/syntax/common/reader.lux
+++ b/stdlib/source/lux/macro/syntax/common/reader.lux
@@ -3,9 +3,9 @@
[abstract
monad]
[control
- ["p" parser ("#;." monad)]]
+ ["p" parser ("#@." monad)]]
[data
- ["." name ("#;." equivalence)]
+ ["." name ("#@." equivalence)]
["." product]
["." maybe]
[collection
@@ -17,8 +17,8 @@
## Exports
(def: #export export
(Syntax Bit)
- (p.either (p.after (s.this (' #export)) (p;wrap #1))
- (p;wrap #0)))
+ (p.either (p.after (s.this (' #export)) (p@wrap #1))
+ (p@wrap #0)))
## Declarations
(def: #export declaration
@@ -28,7 +28,7 @@
(foo bar baz))}
(Syntax //.Declaration)
(p.either (p.and s.local-identifier
- (p;wrap (list)))
+ (p@wrap (list)))
(s.form (p.and s.local-identifier
(p.some s.local-identifier)))))
@@ -46,7 +46,7 @@
type s.any
value s.any]
(wrap [(#.Some type) value])))
- (p.and (p;wrap #.None)
+ (p.and (p@wrap #.None)
s.any)))
(def: _definition-anns-tag^
@@ -92,7 +92,7 @@
(-> (List [Name Code]) (List Text))
(<| (maybe.default (list))
(: (Maybe (List Text)))
- (case (list.find (|>> product.left (name;= ["lux" "func-args"])) meta-data)
+ (case (list.find (|>> product.left (name@= ["lux" "func-args"])) meta-data)
(^multi (#.Some [_ value])
[(p.run (list value) tuple-meta^)
(#.Right [_ args])]
diff --git a/stdlib/source/lux/macro/syntax/common/writer.lux b/stdlib/source/lux/macro/syntax/common/writer.lux
index bf675857d..541f8849b 100644
--- a/stdlib/source/lux/macro/syntax/common/writer.lux
+++ b/stdlib/source/lux/macro/syntax/common/writer.lux
@@ -5,7 +5,7 @@
["." function]]
[data
[collection
- ["." list ("#;." functor)]]
+ ["." list ("#@." functor)]]
["." product]]
[macro
["." code]]]
@@ -20,14 +20,14 @@
(def: #export (declaration declaration)
(-> //.Declaration Code)
(` ((~ (code.local-identifier (get@ #//.declaration-name declaration)))
- (~+ (list;map code.local-identifier
+ (~+ (list@map code.local-identifier
(get@ #//.declaration-args declaration))))))
(def: #export annotations
(-> //.Annotations Code)
- (|>> (list;map (product.both code.tag function.identity))
+ (|>> (list@map (product.both code.tag function.identity))
code.record))
(def: #export type-variables
(-> (List Text) (List Code))
- (list;map code.local-identifier))
+ (list@map code.local-identifier))