diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/lux.lux | 100 | ||||
| -rw-r--r-- | stdlib/source/lux/abstract/enum.lux | 1 | ||||
| -rw-r--r-- | stdlib/source/lux/abstract/monad.lux | 4 | ||||
| -rw-r--r-- | stdlib/source/lux/control/exception.lux | 3 | ||||
| -rw-r--r-- | stdlib/source/lux/control/parser.lux | 1 | ||||
| -rw-r--r-- | stdlib/source/lux/data/collection/dictionary.lux | 3 | ||||
| -rw-r--r-- | stdlib/source/lux/data/name.lux | 1 | ||||
| -rw-r--r-- | stdlib/source/lux/data/text/lexer.lux | 44 | ||||
| -rw-r--r-- | stdlib/source/lux/macro.lux | 80 | ||||
| -rw-r--r-- | stdlib/source/lux/macro/code.lux | 20 | ||||
| -rw-r--r-- | stdlib/source/lux/macro/syntax.lux | 60 | ||||
| -rw-r--r-- | stdlib/source/lux/macro/syntax/common/reader.lux | 14 | ||||
| -rw-r--r-- | stdlib/source/lux/macro/syntax/common/writer.lux | 8 |
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)) |