diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/lux.lux | 514 |
1 files changed, 268 insertions, 246 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index 0b8941ba7..276a8e6e7 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -8,13 +8,13 @@ [dummy_location (9 #1 (0 #0))] #0) -("lux def" new_line +("lux def" \n ("lux i64 char" +10) [dummy_location (9 #1 (0 #0))] #0) ("lux def" __paragraph - ("lux text concat" new_line new_line) + ("lux text concat" \n \n) [dummy_location (9 #1 (0 #0))] #0) @@ -1476,11 +1476,11 @@ (macro:' #export (_$ tokens) (#Cons [(tag$ ["lux" "doc"]) (text$ ("lux text concat" - ("lux text concat" "## Left-association for the application of binary functions over variadic arguments." ..new_line) + ("lux text concat" "## Left-association for the application of binary functions over variadic arguments." ..\n) ("lux text concat" - ("lux text concat" "(_$ text\compose ''Hello, '' name ''. How are you?'')" ..new_line) + ("lux text concat" "(_$ text\compose ''Hello, '' name ''. How are you?'')" ..\n) ("lux text concat" - ("lux text concat" "## =>" ..new_line) + ("lux text concat" "## =>" ..\n) "(text\compose (text\compose ''Hello, '' name) ''. How are you?'')"))))] #Nil) ({(#Cons op tokens') @@ -1498,11 +1498,11 @@ (macro:' #export ($_ tokens) (#Cons [(tag$ ["lux" "doc"]) (text$ ("lux text concat" - ("lux text concat" "## Right-association for the application of binary functions over variadic arguments." ..new_line) + ("lux text concat" "## Right-association for the application of binary functions over variadic arguments." ..\n) ("lux text concat" - ("lux text concat" "($_ text\compose ''Hello, '' name ''. How are you?'')" ..new_line) + ("lux text concat" "($_ text\compose ''Hello, '' name ''. How are you?'')" ..\n) ("lux text concat" - ("lux text concat" "## =>" ..new_line) + ("lux text concat" "## =>" ..\n) "(text\compose ''Hello, '' (text\compose name ''. How are you?''))"))))] #Nil) ({(#Cons op tokens') @@ -2133,9 +2133,9 @@ (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" "## By specifying a pattern (with holes), and the input data to fill those holes, repeats the pattern as many times as necessary." __paragraph - "(template [<name> <diff>]" ..new_line + "(template [<name> <diff>]" ..\n " " "[(def: #export <name> (-> Int Int) (+ <diff>))]" __paragraph - " " "[inc +1]" ..new_line + " " "[inc +1]" ..\n " " "[dec -1]"))]) ({(#Cons [[_ (#Tuple bindings)] (#Cons [[_ (#Tuple templates)] data])]) ({[(#Some bindings') (#Some data')] @@ -2616,10 +2616,10 @@ (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" "## Sequential execution of expressions (great for side-effects)." __paragraph - "(exec" ..new_line - " " "(log! ''#1'')" ..new_line - " " "(log! ''#2'')" ..new_line - " " "(log! ''#3'')" ..new_line + "(exec" ..\n + " " "(log! ''#1'')" ..\n + " " "(log! ''#2'')" ..\n + " " "(log! ''#3'')" ..\n "''YOLO'')"))]) ({(#Cons value actions) (let' [dummy (local_identifier$ "")] @@ -2777,12 +2777,12 @@ (macro:' #export (case tokens) (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" - "## The pattern-matching macro." ..new_line - "## Allows the usage of macros within the patterns to provide custom syntax." ..new_line - "(case (: (List Int) (list +1 +2 +3))" ..new_line - " " "(#Cons x (#Cons y (#Cons z #Nil)))" ..new_line + "## The pattern-matching macro." ..\n + "## Allows the usage of macros within the patterns to provide custom syntax." ..\n + "(case (: (List Int) (list +1 +2 +3))" ..\n + " " "(#Cons x (#Cons y (#Cons z #Nil)))" ..\n " " "(#Some ($_ * x y z))" __paragraph - " " "_" ..new_line + " " "_" ..\n " " "#None)"))]) ({(#Cons value branches) (do meta_monad @@ -2796,13 +2796,13 @@ (macro:' #export (^ tokens) (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" - "## Macro-expanding patterns." ..new_line - "## It's a special macro meant to be used with 'case'." ..new_line - "(case (: (List Int) (list +1 +2 +3))" ..new_line - " (^ (list x y z))" ..new_line + "## Macro-expanding patterns." ..\n + "## It's a special macro meant to be used with 'case'." ..\n + "(case (: (List Int) (list +1 +2 +3))" ..\n + " (^ (list x y z))" ..\n " (#Some ($_ * x y z))" __paragraph - " _" ..new_line + " _" ..\n " #None)"))]) (case tokens (#Cons [_ (#Form (#Cons pattern #Nil))] (#Cons body branches)) @@ -2821,17 +2821,17 @@ (macro:' #export (^or tokens) (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" - "## Or-patterns." ..new_line - "## It's a special macro meant to be used with 'case'." ..new_line + "## Or-patterns." ..\n + "## It's a special macro meant to be used with 'case'." ..\n "(type: Weekday #Monday #Tuesday #Wednesday #Thursday #Friday #Saturday #Sunday)" __paragraph - "(def: (weekend? day)" ..new_line - " (-> Weekday Bit)" ..new_line - " (case day" ..new_line - " (^or #Saturday #Sunday)" ..new_line + "(def: (weekend? day)" ..\n + " (-> Weekday Bit)" ..\n + " (case day" ..\n + " (^or #Saturday #Sunday)" ..\n " #1" __paragraph - " _" ..new_line + " _" ..\n " #0))"))]) (case tokens (^ (list& [_ (#Form patterns)] body branches)) @@ -2859,10 +2859,10 @@ (macro:' #export (let tokens) (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" - "## Creates local bindings." ..new_line - "## Can (optionally) use pattern-matching macros when binding." ..new_line - "(let [x (foo bar)" ..new_line - " y (baz quux)]" ..new_line + "## Creates local bindings." ..\n + "## Can (optionally) use pattern-matching macros when binding." ..\n + "(let [x (foo bar)" ..\n + " y (baz quux)]" ..\n " (op x y))"))]) (case tokens (^ (list [_ (#Tuple bindings)] body)) @@ -2885,12 +2885,12 @@ (macro:' #export (function tokens) (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" - "## Syntax for creating functions." ..new_line - "## Allows for giving the function itself a name, for the sake of recursion." ..new_line - "(: (All [a b] (-> a b a))" ..new_line + "## Syntax for creating functions." ..\n + "## Allows for giving the function itself a name, for the sake of recursion." ..\n + "(: (All [a b] (-> a b a))" ..\n " (function (_ x y) x))" __paragraph - "(: (All [a b] (-> a b a))" ..new_line + "(: (All [a b] (-> a b a))" ..\n " (function (const x y) x))"))]) (case (: (Maybe [Text Code (List Code) Code]) (case tokens @@ -3001,14 +3001,14 @@ (macro:' #export (def: tokens) (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" - "## Defines global constants/functions." ..new_line - "(def: (rejoin_pair pair)" ..new_line - " (-> [Code Code] (List Code))" ..new_line - " (let [[left right] pair]" ..new_line + "## Defines global constants/functions." ..\n + "(def: (rejoin_pair pair)" ..\n + " (-> [Code Code] (List Code))" ..\n + " (let [[left right] pair]" ..\n " (list left right)))" __paragraph - "(def: branching_exponent" ..new_line - " Int" ..new_line + "(def: branching_exponent" ..\n + " Int" ..\n " +5)"))]) (let [[exported? tokens'] (export^ tokens) parts (: (Maybe [Code (List Code) (Maybe Code) Code (List [Code Code])]) @@ -3084,15 +3084,15 @@ (macro:' #export (macro: tokens) (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" - "## Macro-definition macro." ..new_line - "(macro: #export (name_of tokens)" ..new_line - " (case tokens" ..new_line - " (^template [<tag>]" ..new_line - " [(^ (list [_ (<tag> [prefix name])]))" ..new_line - " (return (list (` [(~ (text$ prefix)) (~ (text$ name))])))])" ..new_line + "## Macro-definition macro." ..\n + "(macro: #export (name_of tokens)" ..\n + " (case tokens" ..\n + " (^template [<tag>]" ..\n + " [(^ (list [_ (<tag> [prefix name])]))" ..\n + " (return (list (` [(~ (text$ prefix)) (~ (text$ name))])))])" ..\n " ([#Identifier] [#Tag])" __paragraph - " _" ..new_line + " _" ..\n " (fail ''Wrong syntax for name_of'')))"))]) (let [[exported? tokens] (export^ tokens) name+args+meta+body?? (: (Maybe [Name (List Code) (List [Code Code]) Code]) @@ -3133,17 +3133,17 @@ (macro: #export (signature: tokens) {#.doc (text$ ($_ "lux text concat" - "## Definition of signatures ala ML." ..new_line - "(signature: #export (Ord a)" ..new_line - " (: (Equivalence a)" ..new_line - " eq)" ..new_line - " (: (-> a a Bit)" ..new_line - " <)" ..new_line - " (: (-> a a Bit)" ..new_line - " <=)" ..new_line - " (: (-> a a Bit)" ..new_line - " >)" ..new_line - " (: (-> a a Bit)" ..new_line + "## Definition of signatures ala ML." ..\n + "(signature: #export (Ord a)" ..\n + " (: (Equivalence a)" ..\n + " eq)" ..\n + " (: (-> a a Bit)" ..\n + " <)" ..\n + " (: (-> a a Bit)" ..\n + " <=)" ..\n + " (: (-> a a Bit)" ..\n + " >)" ..\n + " (: (-> a a Bit)" ..\n " >=))"))} (let [[exported? tokens'] (export^ tokens) ?parts (: (Maybe [Name (List Code) Code (List Code)]) @@ -3234,14 +3234,14 @@ (def: #export (error! message) {#.doc (text$ ($_ "lux text concat" - "## Causes an error, with the given error message." ..new_line + "## Causes an error, with the given error message." ..\n "(error! ''OH NO!'')"))} (-> Text Nothing) ("lux io error" message)) (macro: (default tokens state) {#.doc (text$ ($_ "lux text concat" - "## Allows you to provide a default value that will be used" ..new_line + "## Allows you to provide a default value that will be used" ..\n "## if a (Maybe x) value turns out to be #.None." __paragraph "(default +20 (#.Some +10)) ## => +10" @@ -3530,18 +3530,18 @@ (macro: #export (structure: tokens) {#.doc (text$ ($_ "lux text concat" - "## Definition of structures ala ML." ..new_line - "(structure: #export order (Order Int)" ..new_line - " (def: &equivalence equivalence)" ..new_line - " (def: (< test subject)" ..new_line - " (< test subject))" ..new_line - " (def: (<= test subject)" ..new_line - " (or (< test subject)" ..new_line - " (= test subject)))" ..new_line - " (def: (> test subject)" ..new_line - " (> test subject))" ..new_line - " (def: (>= test subject)" ..new_line - " (or (> test subject)" ..new_line + "## Definition of structures ala ML." ..\n + "(structure: #export order (Order Int)" ..\n + " (def: &equivalence equivalence)" ..\n + " (def: (< test subject)" ..\n + " (< test subject))" ..\n + " (def: (<= test subject)" ..\n + " (or (< test subject)" ..\n + " (= test subject)))" ..\n + " (def: (> test subject)" ..\n + " (> test subject))" ..\n + " (def: (>= test subject)" ..\n + " (or (> test subject)" ..\n " (= test subject))))"))} (let [[exported? tokens'] (export^ tokens) ?parts (: (Maybe [Code (List Code) Code Code (List Code)]) @@ -3581,7 +3581,7 @@ (macro: #export (type: tokens) {#.doc (text$ ($_ "lux text concat" - "## The type-definition macro." ..new_line + "## The type-definition macro." ..\n "(type: (List a) #Nil (#Cons a (List a)))"))} (let [[exported? tokens'] (export^ tokens) [rec? tokens'] (case tokens' @@ -3707,7 +3707,7 @@ (return name) _ - (fail "only/exclude requires identifiers.")))) + (fail "#only/#+ and #exclude/#- require identifiers.")))) defs)) (def: (parse_referrals tokens) @@ -3850,9 +3850,9 @@ _ ($_ text\compose prefix ..module_separator clean))] (return output)) (fail ($_ "lux text concat" - "Cannot climb the module hierarchy..." ..new_line - "Importing module: " module ..new_line - " Relative Root: " relative_root ..new_line)))))) + "Cannot climb the module hierarchy..." ..\n + "Importing module: " module ..\n + " Relative Root: " relative_root ..\n)))))) (def: (alter_domain alteration domain import) (-> Nat Text Importation Importation) @@ -3945,7 +3945,7 @@ [current_module current_module_name] (fail ($_ text\compose "Wrong syntax for import @ " current_module - ..new_line (code\encode token))))))) + ..\n (code\encode token))))))) imports)] (wrap (list\join imports')))) @@ -3976,13 +3976,13 @@ #None (#Left ($_ text\compose - "Unknown module: " (text\encode module) ..new_line + "Unknown module: " (text\encode module) ..\n "Current module: " (case current_module (#Some current_module) (text\encode current_module) #None - "???") ..new_line + "???") ..\n "Known modules: " (|> modules (list\map (function (_ [name module]) (text$ name))) @@ -4203,10 +4203,10 @@ (macro: #export (^open tokens) {#.doc (text$ ($_ "lux text concat" - "## Same as the 'open' macro, but meant to be used as a pattern-matching macro for generating local bindings." ..new_line - "## Takes an 'alias' text for the generated local bindings." ..new_line - "(def: #export (range (^open ''.'') from to)" ..new_line - " (All [a] (-> (Enum a) a a (List a)))" ..new_line + "## Same as the 'open' macro, but meant to be used as a pattern-matching macro for generating local bindings." ..\n + "## Takes an 'alias' text for the generated local bindings." ..\n + "(def: #export (range (^open ''.'') from to)" ..\n + " (All [a] (-> (Enum a) a a (List a)))" ..\n " (range' <= succ from to))"))} (case tokens (^ (list& [_ (#Form (list [_ (#Text alias)]))] body branches)) @@ -4254,11 +4254,11 @@ (macro: #export (cond tokens) {#.doc (text$ ($_ "lux text concat" - "## Branching structures with multiple test conditions." ..new_line - "(cond (even? num) ''even''" ..new_line + "## Branching structures with multiple test conditions." ..\n + "(cond (even? num) ''even''" ..\n " (odd? num) ''odd''" __paragraph - " ## else_branch" ..new_line + " ## else_branch" ..\n " ''???'')"))} (if ("lux i64 =" 0 (n/% 2 (list\size tokens))) (fail "cond requires an uneven number of arguments.") @@ -4289,14 +4289,14 @@ (macro: #export (get@ tokens) {#.doc (text$ ($_ "lux text concat" - "## Accesses the value of a record at a given tag." ..new_line + "## Accesses the value of a record at a given tag." ..\n "(get@ #field my_record)" __paragraph - "## Can also work with multiple levels of nesting:" ..new_line + "## Can also work with multiple levels of nesting:" ..\n "(get@ [#foo #bar #baz] my_record)" __paragraph - "## And, if only the slot/path is given, generates an accessor function:" ..new_line - "(let [getter (get@ [#foo #bar #baz])]" ..new_line + "## And, if only the slot/path is given, generates an accessor function:" ..\n + "(let [getter (get@ [#foo #bar #baz])]" ..\n " (getter my_record))"))} (case tokens (^ (list [_ (#Tag slot')] record)) @@ -4370,13 +4370,13 @@ {#.doc (text$ ($_ "lux text concat" "## Opens a structure and generates a definition for each of its members (including nested members)." __paragraph - "## For example:" ..new_line + "## For example:" ..\n "(open: ''i:.'' number)" __paragraph - "## Will generate:" ..new_line - "(def: i:+ (\ number +))" ..new_line - "(def: i:- (\ number -))" ..new_line - "(def: i:* (\ number *))" ..new_line + "## Will generate:" ..\n + "(def: i:+ (\ number +))" ..\n + "(def: i:- (\ number -))" ..\n + "(def: i:* (\ number *))" ..\n "..."))} (case tokens (^ (list [_ (#Text alias)] struct)) @@ -4411,9 +4411,9 @@ (macro: #export (|>> tokens) {#.doc (text$ ($_ "lux text concat" - "## Similar to the piping macro, but rather than taking an initial object to work on, creates a function for taking it." ..new_line - "(|>> (list\map int\encode) (interpose '' '') (fold text\compose ''''))" ..new_line - "## =>" ..new_line + "## Similar to the piping macro, but rather than taking an initial object to work on, creates a function for taking it." ..\n + "(|>> (list\map int\encode) (interpose '' '') (fold text\compose ''''))" ..\n + "## =>" ..\n "(function (_ <arg>) (fold text\compose '''' (interpose '' '' (list\map int\encode <arg>))))"))} (do meta_monad [g!_ (gensym "_") @@ -4422,9 +4422,9 @@ (macro: #export (<<| tokens) {#.doc (text$ ($_ "lux text concat" - "## Similar to the piping macro, but rather than taking an initial object to work on, creates a function for taking it." ..new_line - "(<<| (fold text\compose '''') (interpose '' '') (list\map int\encode))" ..new_line - "## =>" ..new_line + "## Similar to the piping macro, but rather than taking an initial object to work on, creates a function for taking it." ..\n + "(<<| (fold text\compose '''') (interpose '' '') (list\map int\encode))" ..\n + "## =>" ..\n "(function (_ <arg>) (fold text\compose '''' (interpose '' '' (list\map int\encode <arg>))))"))} (do meta_monad [g!_ (gensym "_") @@ -4453,10 +4453,10 @@ _ (fail ($_ text\compose "Wrong syntax for refer @ " current_module - ..new_line (|> options - (list\map code\encode) - (interpose " ") - (list\fold text\compose ""))))))) + ..\n (|> options + (list\map code\encode) + (interpose " ") + (list\fold text\compose ""))))))) (def: (write_refer module_name [r_defs r_opens]) (-> Text Refer (Meta (List Code))) @@ -4549,17 +4549,17 @@ __paragraph "## Can take optional annotations and allows the specification of modules to import." __paragraph - "## Example" ..new_line - "(.module: {#.doc ''Some documentation...''}" ..new_line - " [lux #*" ..new_line - " [control" ..new_line - " [''M'' monad #*]]" ..new_line - " [data" ..new_line - " maybe" ..new_line - " [''.'' name (''#/.'' codec)]]" ..new_line - " [macro" ..new_line - " code]]" ..new_line - " [//" ..new_line + "## Example" ..\n + "(.module: {#.doc ''Some documentation...''}" ..\n + " [lux #*" ..\n + " [control" ..\n + " [''M'' monad #*]]" ..\n + " [data" ..\n + " maybe" ..\n + " [''.'' name (''#/.'' codec)]]" ..\n + " [macro" ..\n + " code]]" ..\n + " [//" ..\n " [type (''.'' equivalence)]])"))} (do meta_monad [#let [[_meta _imports] (: [(List [Code Code]) (List Code)] @@ -4587,31 +4587,31 @@ (macro: #export (\ tokens) {#.doc (text$ ($_ "lux text concat" - "## Allows accessing the value of a structure's member." ..new_line + "## Allows accessing the value of a structure's member." ..\n "(\ codec encode)" __paragraph - "## Also allows using that value as a function." ..new_line + "## Also allows using that value as a function." ..\n "(\ codec encode +123)"))} (case tokens (^ (list struct [_ (#Identifier member)])) - (return (list (` (let [(^open ".") (~ struct)] (~ (identifier$ member)))))) + (return (list (` (let [(^open (~ (text$ ..self_reference))) (~ struct)] (~ (identifier$ member)))))) - (^ (list& struct [_ (#Identifier member)] args)) - (return (list (` ((let [(^open ".") (~ struct)] (~ (identifier$ member))) (~+ args))))) + (^ (list& struct member args)) + (return (list (` ((..\ (~ struct) (~ member)) (~+ args))))) _ (fail "Wrong syntax for \"))) (macro: #export (set@ tokens) {#.doc (text$ ($_ "lux text concat" - "## Sets the value of a record at a given tag." ..new_line + "## Sets the value of a record at a given tag." ..\n "(set@ #name ''Lux'' lang)" __paragraph - "## Can also work with multiple levels of nesting:" ..new_line + "## Can also work with multiple levels of nesting:" ..\n "(set@ [#foo #bar #baz] value my_record)" __paragraph - "## And, if only the slot/path and (optionally) the value are given, generates a mutator function:" ..new_line - "(let [setter (set@ [#foo #bar #baz] value)] (setter my_record))" ..new_line + "## And, if only the slot/path and (optionally) the value are given, generates a mutator function:" ..\n + "(let [setter (set@ [#foo #bar #baz] value)] (setter my_record))" ..\n "(let [setter (set@ [#foo #bar #baz])] (setter value my_record))"))} (case tokens (^ (list [_ (#Tag slot')] value record)) @@ -4677,28 +4677,30 @@ (do meta_monad [g!_ (gensym "_") g!record (gensym "record")] - (wrap (list (` (function ((~ g!_) (~ g!record)) (..set@ (~ selector) (~ value) (~ g!record))))))) + (wrap (list (` (function ((~ g!_) (~ g!record)) + (..set@ (~ selector) (~ value) (~ g!record))))))) (^ (list selector)) (do meta_monad [g!_ (gensym "_") g!value (gensym "value") g!record (gensym "record")] - (wrap (list (` (function ((~ g!_) (~ g!value) (~ g!record)) (..set@ (~ selector) (~ g!value) (~ g!record))))))) + (wrap (list (` (function ((~ g!_) (~ g!value) (~ g!record)) + (..set@ (~ selector) (~ g!value) (~ g!record))))))) _ (fail "Wrong syntax for set@"))) (macro: #export (update@ tokens) {#.doc (text$ ($_ "lux text concat" - "## Modifies the value of a record at a given tag, based on some function." ..new_line + "## Modifies the value of a record at a given tag, based on some function." ..\n "(update@ #age inc person)" __paragraph - "## Can also work with multiple levels of nesting:" ..new_line + "## Can also work with multiple levels of nesting:" ..\n "(update@ [#foo #bar #baz] func my_record)" __paragraph - "## And, if only the slot/path and (optionally) the value are given, generates a mutator function:" ..new_line - "(let [updater (update@ [#foo #bar #baz] func)] (updater my_record))" ..new_line + "## And, if only the slot/path and (optionally) the value are given, generates a mutator function:" ..\n + "(let [updater (update@ [#foo #bar #baz] func)] (updater my_record))" ..\n "(let [updater (update@ [#foo #bar #baz])] (updater func my_record))"))} (case tokens (^ (list [_ (#Tag slot')] fun record)) @@ -4750,52 +4752,54 @@ (do meta_monad [g!_ (gensym "_") g!record (gensym "record")] - (wrap (list (` (function ((~ g!_) (~ g!record)) (..update@ (~ selector) (~ fun) (~ g!record))))))) + (wrap (list (` (function ((~ g!_) (~ g!record)) + (..update@ (~ selector) (~ fun) (~ g!record))))))) (^ (list selector)) (do meta_monad [g!_ (gensym "_") g!fun (gensym "fun") g!record (gensym "record")] - (wrap (list (` (function ((~ g!_) (~ g!fun) (~ g!record)) (..update@ (~ selector) (~ g!fun) (~ g!record))))))) + (wrap (list (` (function ((~ g!_) (~ g!fun) (~ g!record)) + (..update@ (~ selector) (~ g!fun) (~ g!record))))))) _ (fail "Wrong syntax for update@"))) (macro: #export (^template tokens) {#.doc (text$ ($_ "lux text concat" - "## It's similar to template, but meant to be used during pattern-matching." ..new_line - "(def: (beta_reduce env type)" ..new_line - " (-> (List Type) Type Type)" ..new_line - " (case type" ..new_line - " (#.Primitive name params)" ..new_line + "## It's similar to template, but meant to be used during pattern-matching." ..\n + "(def: (beta_reduce env type)" ..\n + " (-> (List Type) Type Type)" ..\n + " (case type" ..\n + " (#.Primitive name params)" ..\n " (#.Primitive name (list\map (beta_reduce env) params))" __paragraph - " (^template [<tag>]" ..new_line - " [(<tag> left right)" ..new_line - " (<tag> (beta_reduce env left) (beta_reduce env right))])" ..new_line + " (^template [<tag>]" ..\n + " [(<tag> left right)" ..\n + " (<tag> (beta_reduce env left) (beta_reduce env right))])" ..\n " ([#.Sum] [#.Product])" __paragraph - " (^template [<tag>]" ..new_line - " [(<tag> left right)" ..new_line - " (<tag> (beta_reduce env left) (beta_reduce env right))])" ..new_line + " (^template [<tag>]" ..\n + " [(<tag> left right)" ..\n + " (<tag> (beta_reduce env left) (beta_reduce env right))])" ..\n " ([#.Function] [#.Apply])" __paragraph - " (^template [<tag>]" ..new_line - " [(<tag> old_env def)" ..new_line - " (case old_env" ..new_line - " #.Nil" ..new_line + " (^template [<tag>]" ..\n + " [(<tag> old_env def)" ..\n + " (case old_env" ..\n + " #.Nil" ..\n " (<tag> env def)" __paragraph - " _" ..new_line - " type)])" ..new_line + " _" ..\n + " type)])" ..\n " ([#.UnivQ] [#.ExQ])" __paragraph - " (#.Parameter idx)" ..new_line + " (#.Parameter idx)" ..\n " (default type (list.nth idx env))" __paragraph - " _" ..new_line - " type" ..new_line + " _" ..\n + " type" ..\n " ))"))} (case tokens (^ (list& [_ (#Form (list [_ (#Tuple bindings)] @@ -4889,7 +4893,7 @@ (-> Nat Location Location Text) (if ("lux i64 =" old_line new_line) (text\join_with "" (repeat (.int ("lux i64 -" old_column new_column)) " ")) - (let [extra_lines (text\join_with "" (repeat (.int ("lux i64 -" old_line new_line)) ..new_line)) + (let [extra_lines (text\join_with "" (repeat (.int ("lux i64 -" old_line new_line)) ..\n)) space_padding (text\join_with "" (repeat (.int ("lux i64 -" baseline new_column)) " "))] (text\compose extra_lines space_padding)))) @@ -4955,8 +4959,8 @@ (case fragment (#Doc_Comment comment) (|> comment - (text\split_all_with ..new_line) - (list\map (function (_ line) ($_ text\compose "## " line ..new_line))) + (text\split_all_with ..\n) + (list\map (function (_ line) ($_ text\compose "## " line ..\n))) (text\join_with "")) (#Doc_Example example) @@ -4969,13 +4973,13 @@ {#.doc (text$ ($_ "lux text concat" "## Creates code documentation, embedding text as comments and properly formatting the forms it's being given." __paragraph - "## For Example:" ..new_line - "(doc ''Allows arbitrary looping, using the 'recur' form to re-start the loop.''" ..new_line - " ''Can be used in monadic code to create monadic loops.''" ..new_line - " (loop [count +0" ..new_line - " x init]" ..new_line - " (if (< +10 count)" ..new_line - " (recur (inc count) (f x))" ..new_line + "## For Example:" ..\n + "(doc ''Allows arbitrary looping, using the 'recur' form to re-start the loop.''" ..\n + " ''Can be used in monadic code to create monadic loops.''" ..\n + " (loop [count +0" ..\n + " x init]" ..\n + " (if (< +10 count)" ..\n + " (recur (inc count) (f x))" ..\n " x)))"))} (return (list (` [(~ location_code) (#.Text (~ (|> tokens @@ -5165,8 +5169,8 @@ (macro: #export (with_expansions tokens) {#.doc (doc "Controlled macro-expansion." - "Bind an arbitraty number of Codes resulting from macro-expansion to local bindings." - "Wherever a binding appears, the bound codes will be spliced in there." + "Bind an arbitraty number of Code nodes resulting from macro-expansion to local bindings." + "Wherever a binding appears, the bound Code nodes will be spliced in there." (test: "Code operations & structures" (with_expansions [<tests> (template [<expr> <text> <pattern>] @@ -5677,6 +5681,32 @@ (function (_ compiler) (#Right [compiler (get@ [#info #target] compiler)]))) +(def: (resolve_target choice) + (-> Code (Meta Text)) + (case choice + [_ (#Text platform)] + (..return platform) + + [_ (#Identifier identifier)] + (do meta_monad + [identifier (..resolve_global_identifier identifier) + type+value (..find_def_value identifier) + #let [[type value] type+value]] + (case (..flatten_alias type) + (^or (#Primitive "#Text" #Nil) + (#Named ["lux" "Text"] (#Primitive "#Text" #Nil))) + (wrap (:coerce ..Text value)) + + _ + (fail ($_ text\compose + "Invalid target platform (must be a value of type Text): " (name\encode identifier) + " : " (..code\encode (..type_to_code type)))))) + + _ + (fail ($_ text\compose + "Invalid target platform syntax: " (..code\encode choice) + ..\n "Must be either a text literal or an identifier.")))) + (def: (target_pick target options default) (-> Text (List [Code Code]) (Maybe Code) (Meta (List Code))) (case options @@ -5689,32 +5719,11 @@ (return (list default))) (#Cons [key pick] options') - (with_expansions [<try_again> (target_pick target options' default)] - (case key - [_ (#Text platform)] - (if (text\= target platform) - (return (list pick)) - <try_again>) - - [_ (#Identifier identifier)] - (do meta_monad - [identifier (..resolve_global_identifier identifier) - type+value (..find_def_value identifier) - #let [[type value] type+value]] - (case (..flatten_alias type) - (#Named ["lux" "Text"] (#Primitive "#Text" #Nil)) - (if (text\= target (:coerce ..Text value)) - (wrap (list pick)) - <try_again>) - - _ - (fail ($_ text\compose - "Invalid target platform (must be a value of type Text): " (name\encode identifier) - " : " (..code\encode (..type_to_code type)))))) - - _ - <try_again>)) - )) + (do meta_monad + [platform (..resolve_target key)] + (if (text\= target platform) + (return (list pick)) + (target_pick target options' default))))) (macro: #export (for tokens) (do meta_monad @@ -5799,58 +5808,71 @@ (#Cons [init inits']) (` (#.Cons (~ init) (~ (untemplate_list& last inits')))))) -(def: (untemplate_pattern pattern) - (-> Code (Meta Code)) - (case pattern - (^template [<tag> <name> <gen>] - [[_ (<tag> value)] +(def: (untemplate_record g!meta untemplate_pattern fields) + (-> Code (-> Code (Meta Code)) + (-> (List [Code Code]) (Meta Code))) + (do meta_monad + [=fields (monad\map meta_monad + (function (_ [key value]) + (do meta_monad + [=key (untemplate_pattern key) + =value (untemplate_pattern value)] + (wrap (` [(~ =key) (~ =value)])))) + fields)] + (wrap (` [(~ g!meta) (#.Record (~ (untemplate_list =fields)))])))) + +(template [<tag> <name>] + [(def: (<name> g!meta untemplate_pattern elems) + (-> Code (-> Code (Meta Code)) + (-> (List Code) (Meta Code))) + (case (list\reverse elems) + (#Cons [_ (#Form (#Cons [[_ (#Identifier ["" "~+"])] (#Cons [spliced #Nil])]))] + inits) (do meta_monad - [g!meta (gensym "g!meta")] - (wrap (` [(~ g!meta) (<tag> (~ (<gen> value)))])))]) - ([#Bit "Bit" bit$] - [#Nat "Nat" nat$] - [#Int "Int" int$] - [#Rev "Rev" rev$] - [#Frac "Frac" frac$] - [#Text "Text" text$] - [#Tag "Tag" name$] - [#Identifier "Identifier" name$]) - - [_ (#Record fields)] - (do meta_monad - [=fields (monad\map meta_monad - (function (_ [key value]) - (do meta_monad - [=key (untemplate_pattern key) - =value (untemplate_pattern value)] - (wrap (` [(~ =key) (~ =value)])))) - fields) - g!meta (gensym "g!meta")] - (wrap (` [(~ g!meta) (#.Record (~ (untemplate_list =fields)))]))) - - [_ (#Form (#Cons [[_ (#Identifier ["" "~"])] (#Cons [unquoted #Nil])]))] - (return unquoted) - - [_ (#Form (#Cons [[_ (#Identifier ["" "~+"])] (#Cons [spliced #Nil])]))] - (fail "Cannot use (~+) inside of ^code unless it is the last element in a form or a tuple.") + [=inits (monad\map meta_monad untemplate_pattern (list\reverse inits))] + (wrap (` [(~ g!meta) (<tag> (~ (untemplate_list& spliced =inits)))]))) - (^template [<tag>] - [[_ (<tag> elems)] - (case (list\reverse elems) - (#Cons [_ (#Form (#Cons [[_ (#Identifier ["" "~+"])] (#Cons [spliced #Nil])]))] - 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 meta_monad + [=elems (monad\map meta_monad untemplate_pattern elems)] + (wrap (` [(~ g!meta) (<tag> (~ (untemplate_list =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]) - )) + [#.Tuple untemplate_tuple] + [#.Form untemplate_form] + ) + +(def: (untemplate_pattern pattern) + (-> Code (Meta Code)) + (do meta_monad + [g!meta (gensym "g!meta")] + (case pattern + (^template [<tag> <gen>] + [[_ (<tag> value)] + (wrap (` [(~ g!meta) (<tag> (~ (<gen> value)))]))]) + ([#.Bit bit$] + [#.Nat nat$] + [#.Int int$] + [#.Rev rev$] + [#.Frac frac$] + [#.Text text$] + [#.Tag name$] + [#.Identifier name$]) + + [_ (#Form (#Cons [[_ (#Identifier ["" "~"])] (#Cons [unquoted #Nil])]))] + (return unquoted) + + [_ (#Form (#Cons [[_ (#Identifier ["" "~+"])] (#Cons [spliced #Nil])]))] + (fail "Cannot use (~+) inside of ^code unless it is the last element in a form or a tuple.") + + (^template [<tag> <untemplate>] + [[_ (<tag> elems)] + (<untemplate> g!meta untemplate_pattern elems)]) + ([#.Tuple ..untemplate_tuple] + [#.Form ..untemplate_form]) + + [_ (#Record fields)] + (..untemplate_record g!meta untemplate_pattern fields) + ))) (macro: #export (^code tokens) (case tokens |