From a62ce3f9c2b605e0033f4772b0f64c4525de4d86 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 11 Aug 2021 02:38:59 -0400 Subject: Relocated maybe and lazy from data to control. --- stdlib/source/library/lux.lux | 420 +++++++++++++++++++++--------------------- 1 file changed, 210 insertions(+), 210 deletions(-) (limited to 'stdlib/source/library/lux.lux') diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux index 5e27a94c4..9034ba1fd 100644 --- a/stdlib/source/library/lux.lux +++ b/stdlib/source/library/lux.lux @@ -1752,7 +1752,7 @@ (identifier$ ["library/lux" "List"])))] (form$ (list (text$ "lux type check") type expression)))) -(def:''' .private (spliced replace? untemplate elems) +(def:''' .private (spliced replace? untemplated elems) #End (-> Bit (-> Code ($' Meta Code)) ($' List Code) ($' Meta Code)) ({#1 @@ -1766,7 +1766,7 @@ _ (do meta_monad - [lastO (untemplate lastI)] + [lastO (untemplated lastI)] (in (code_list (form$ (list (tag$ ["library/lux" "Item"]) (tuple$ (list lastO (tag$ ["library/lux" "End"]))))))))} lastI)] @@ -1780,7 +1780,7 @@ _ (do meta_monad - [leftO (untemplate leftI)] + [leftO (untemplated leftI)] (in (form$ (list (tag$ ["library/lux" "Item"]) (tuple$ (list leftO rightO))))))} leftI)) lastO @@ -1788,7 +1788,7 @@ (list\reverse elems)) #0 (do meta_monad - [=elems (monad\map meta_monad untemplate elems)] + [=elems (monad\map meta_monad untemplated elems)] (in (untemplated_list =elems)))} replace?)) @@ -1797,7 +1797,7 @@ (-> Text Code) (with_location (form$ (list (tag$ ["library/lux" "Text"]) (text$ value))))) -(def:''' .private (untemplate replace? subst token) +(def:''' .private (untemplated replace? subst token) #End (-> Bit Text Code ($' Meta Code)) ({[_ [_ (#Bit value)]] @@ -1853,24 +1853,24 @@ [#1 [_ (#Form (#Item [[_ (#Identifier ["" "~!"])] (#Item [dependent #End])]))]] (do meta_monad - [independent (untemplate replace? subst dependent)] + [independent (untemplated replace? subst dependent)] (in (with_location (form$ (list (tag$ ["library/lux" "Form"]) (untemplated_list (list (untemplated_text "lux in-module") (untemplated_text subst) independent))))))) [#1 [_ (#Form (#Item [[_ (#Identifier ["" "~'"])] (#Item [keep_quoted #End])]))]] - (untemplate #0 subst keep_quoted) + (untemplated #0 subst keep_quoted) [_ [meta (#Form elems)]] (do meta_monad - [output (spliced replace? (untemplate replace? subst) elems) + [output (spliced replace? (untemplated replace? subst) elems) .let' [[_ output'] (with_location (form$ (list (tag$ ["library/lux" "Form"]) output)))]] (in [meta output'])) [_ [meta (#Tuple elems)]] (do meta_monad - [output (spliced replace? (untemplate replace? subst) elems) + [output (spliced replace? (untemplated replace? subst) elems) .let' [[_ output'] (with_location (form$ (list (tag$ ["library/lux" "Tuple"]) output)))]] (in [meta output'])) @@ -1881,8 +1881,8 @@ (function' [kv] (let' [[k v] kv] (do meta_monad - [=k (untemplate replace? subst k) - =v (untemplate replace? subst v)] + [=k (untemplated replace? subst k) + =v (untemplated replace? subst v)] (in (tuple$ (list =k =v))))))) fields)] (in (with_location (form$ (list (tag$ ["library/lux" "Record"]) (untemplated_list =fields))))))} @@ -1928,7 +1928,7 @@ ({(#Item template #End) (do meta_monad [current_module current_module_name - =template (untemplate #1 current_module template)] + =template (untemplated #1 current_module template)] (in (list (form$ (list (text$ "lux type check") (identifier$ ["library/lux" "Code"]) =template))))) @@ -1944,7 +1944,7 @@ "(`' (def: (~ name) (function (_ (~+ args)) (~ body))))"))]) ({(#Item template #End) (do meta_monad - [=template (untemplate #1 "" template)] + [=template (untemplated #1 "" template)] (in (list (form$ (list (text$ "lux type check") (identifier$ ["library/lux" "Code"]) =template))))) _ @@ -1958,7 +1958,7 @@ "(' YOLO)"))]) ({(#Item template #End) (do meta_monad - [=template (untemplate #0 "" template)] + [=template (untemplated #0 "" template)] (in (list (form$ (list (text$ "lux type check") (identifier$ ["library/lux" "Code"]) =template))))) _ @@ -1969,9 +1969,9 @@ (list [(tag$ ["library/lux" "doc"]) (text$ ($_ "lux text concat" "... Piping macro." __paragraph - "(|> elems (list\map int\encode) (interpose '' '') (fold text\compose ''''))" __paragraph + "(|> elems (list\map int\encode) (interposed '' '') (fold text\compose ''''))" __paragraph "... =>" __paragraph - "(fold text\compose '''' (interpose '' '' (list\map int\encode elems)))"))]) + "(fold text\compose '''' (interposed '' '' (list\map int\encode elems)))"))]) ({(#Item [init apps]) (in_meta (list (list\fold ("lux type check" (-> Code Code Code) (function' [app acc] @@ -1995,9 +1995,9 @@ (list [(tag$ ["library/lux" "doc"]) (text$ ($_ "lux text concat" "... Reverse piping macro." __paragraph - "(<| (fold text\compose '''') (interpose '' '') (list\map int\encode) elems)" __paragraph + "(<| (fold text\compose '''') (interposed '' '') (list\map int\encode) elems)" __paragraph "... =>" __paragraph - "(fold text\compose '''' (interpose '' '' (list\map int\encode elems)))"))]) + "(fold text\compose '''' (interposed '' '' (list\map int\encode elems)))"))]) ({(#Item [init apps]) (in_meta (list (list\fold ("lux type check" (-> Code Code Code) (function' [app acc] @@ -2064,7 +2064,7 @@ #None} tuple)) -(def:''' .private (apply_template env template) +(def:''' .private (realized_template env template) #End (-> Replacement_Environment Code Code) ({[_ (#Identifier "" sname)] @@ -2076,16 +2076,16 @@ (..replacement sname env)) [meta (#Tuple elems)] - [meta (#Tuple (list\map (apply_template env) elems))] + [meta (#Tuple (list\map (realized_template env) elems))] [meta (#Form elems)] - [meta (#Form (list\map (apply_template env) elems))] + [meta (#Form (list\map (realized_template env) elems))] [meta (#Record members)] [meta (#Record (list\map ("lux type check" (-> (Tuple Code Code) (Tuple Code Code)) (function' [kv] (let' [[slot value] kv] - [(apply_template env slot) (apply_template env value)]))) + [(realized_template env slot) (realized_template env value)]))) members))] _ @@ -2150,7 +2150,7 @@ ({(#Item [[_ (#Tuple bindings)] (#Item [[_ (#Tuple templates)] data])]) ({[(#Some bindings') (#Some data')] (let' [apply ("lux type check" (-> Replacement_Environment ($' List Code)) - (function' [env] (list\map (apply_template env) templates))) + (function' [env] (list\map (realized_template env) templates))) num_bindings (list\size bindings')] (if (every? (function' [size] ("lux i64 =" num_bindings size)) (list\map list\size data')) @@ -2348,7 +2348,7 @@ #None #0} output)))) -(def:''' .private (interpose sep xs) +(def:''' .private (list\interposed sep xs) #End (All [a] (-> a ($' List a) ($' List a))) @@ -2359,7 +2359,7 @@ xs (#Item [x xs']) - (list& x sep (interpose sep xs'))} + (list& x sep (list\interposed sep xs'))} xs)) (def:''' .private (single_expansion token) @@ -2591,7 +2591,7 @@ (failure "Improper type-definition syntax")} type_codes)) -(def:''' .private (gensym prefix state) +(def:''' .private (identifier prefix state) #End (-> Text ($' Meta Code)) ({{#info info #source source #current_module _ #modules modules @@ -2721,14 +2721,14 @@ [_ (#Form xs)] ($_ text\compose "(" (|> xs (list\map code\encode) - (interpose " ") + (list\interposed " ") list\reverse (list\fold text\compose "")) ")") [_ (#Tuple xs)] ($_ text\compose "[" (|> xs (list\map code\encode) - (interpose " ") + (list\interposed " ") list\reverse (list\fold text\compose "")) "]") @@ -2736,7 +2736,7 @@ ($_ text\compose "{" (|> kvs (list\map (function' [kv] ({[k v] ($_ text\compose (code\encode k) " " (code\encode v))} kv))) - (interpose " ") + (list\interposed " ") list\reverse (list\fold text\compose "")) "}")} code)) @@ -2769,7 +2769,7 @@ _ (failure ($_ text\compose "'lux.case' expects an even number of tokens: " (|> branches (list\map code\encode) - (interpose " ") + (list\interposed " ") list\reverse (list\fold text\compose ""))))} branches)) @@ -3090,7 +3090,7 @@ (case tokens (^ (list else then)) (do meta_monad - [g!_ (gensym "g!_")] + [g!_ (..identifier "g!_")] (in (list (` (..case (~ then) (#..Some (~ g!_)) (#..Some (~ g!_)) @@ -3313,10 +3313,10 @@ (-> Text Text (Maybe Nat)) ("lux text index" 0 part text)) -(def: .public (error! message) +(def: .public (panic! message) {#.doc (text$ ($_ "lux text concat" "... Causes an error, with the given error message." ..\n - "(error! ''OH NO!'')"))} + "(panic! ''OH NO!'')"))} (-> Text Nothing) ("lux io error" message)) @@ -3745,7 +3745,7 @@ {#.doc (text$ ($_ "lux text concat" "... The type-definition macro." ..\n "(type: (List a)" ..\n - " {#.doc (doc (: (List Nat) (list 0 1 2 3)))}" ..\n + " {#.doc (example (: (List Nat) (list 0 1 2 3)))}" ..\n " #End" ..\n " (#Item a (List a)))"))} (case (typeP tokens) @@ -4022,7 +4022,7 @@ _ #.None)) -(def: (count_relatives relatives input) +(def: (relative_ups relatives input) (-> Nat Text Nat) (case ("lux text index" relatives ..module_separator input) #None @@ -4030,7 +4030,7 @@ (#Some found) (if ("lux i64 =" relatives found) - (count_relatives ("lux i64 +" 1 relatives) input) + (relative_ups ("lux i64 +" 1 relatives) input) relatives))) (def: (list\take amount list) @@ -4053,7 +4053,7 @@ (def: (absolute_module_name nested? relative_root module) (-> Bit Text Text (Meta Text)) - (case (count_relatives 0 module) + (case (relative_ups 0 module) 0 (in_meta (if nested? ($_ "lux text concat" relative_root ..module_separator module) @@ -4067,7 +4067,7 @@ list\reverse (list\drop jumps) list\reverse - (interpose ..module_separator) + (list\interposed ..module_separator) (text\join_with "")) clean ("lux text clip" relatives (|> module "lux text size" ("lux i64 -" relatives)) module) output (case ("lux text size" clean) @@ -4370,16 +4370,16 @@ name _ - ($_ text\compose "(" name " " (|> params (list\map type\encode) (interpose " ") list\reverse (list\fold text\compose "")) ")")) + ($_ text\compose "(" name " " (|> params (list\map type\encode) (list\interposed " ") list\reverse (list\fold text\compose "")) ")")) (#Sum _) - ($_ text\compose "(Or " (|> (flat_variant type) (list\map type\encode) (interpose " ") list\reverse (list\fold text\compose "")) ")") + ($_ text\compose "(Or " (|> (flat_variant type) (list\map type\encode) (list\interposed " ") list\reverse (list\fold text\compose "")) ")") (#Product _) - ($_ text\compose "[" (|> (flat_tuple type) (list\map type\encode) (interpose " ") list\reverse (list\fold text\compose "")) "]") + ($_ text\compose "[" (|> (flat_tuple type) (list\map type\encode) (list\interposed " ") list\reverse (list\fold text\compose "")) "]") (#Function _) - ($_ text\compose "(-> " (|> (flat_lambda type) (list\map type\encode) (interpose " ") list\reverse (list\fold text\compose "")) ")") + ($_ text\compose "(-> " (|> (flat_lambda type) (list\map type\encode) (list\interposed " ") list\reverse (list\fold text\compose "")) ")") (#Parameter id) (nat\encode id) @@ -4400,7 +4400,7 @@ (let [[func args] (flat_application type)] ($_ text\compose "(" (type\encode func) " " - (|> args (list\map type\encode) (interpose " ") list\reverse (list\fold text\compose "")) + (|> args (list\map type\encode) (list\interposed " ") list\reverse (list\fold text\compose "")) ")")) (#Named name _) @@ -4417,7 +4417,7 @@ (case tokens (^ (list& [_ (#Form (list [_ (#Text alias)]))] body branches)) (do meta_monad - [g!temp (gensym "temp")] + [g!temp (..identifier "temp")] (in (list& g!temp (` (..^open (~ g!temp) (~ (text$ alias)) (~ body))) branches))) (^ (list [_ (#Identifier name)] [_ (#Text alias)] body)) @@ -4510,8 +4510,8 @@ [slot (normal slot') output (..type_tag slot) .let [[idx tags exported? type] output] - g!_ (gensym "_") - g!output (gensym "")] + g!_ (..identifier "_") + g!output (..identifier "")] (case (interface_methods type) (#Some members) (let [pattern (record$ (list\map (: (-> [Name [Nat Type]] [Code Code]) @@ -4535,8 +4535,8 @@ (^ (list selector)) (do meta_monad - [g!_ (gensym "_") - g!record (gensym "record")] + [g!_ (..identifier "_") + g!record (..identifier "record")] (in (list (` (function ((~ g!_) (~ g!record)) (..get@ (~ selector) (~ g!record))))))) _ @@ -4546,7 +4546,7 @@ (-> Text (List Name) Nat Name Code Type (Meta (List Code))) (do meta_monad [output (record_slots type) - g!_ (gensym "g!_") + g!_ (..identifier "g!_") .let [g!output (local_identifier$ short) pattern (|> tags enumeration @@ -4606,7 +4606,7 @@ _ (do meta_monad - [g!struct (gensym "struct")] + [g!struct (..identifier "struct")] (in_meta (list (` ("lux def" (~ g!struct) (~ struct) [(~ location_code) (#.Record #End)] #0)) @@ -4618,23 +4618,23 @@ (macro: .public (|>> 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." ..\n - "(|>> (list\map int\encode) (interpose '' '') (fold text\compose ''''))" ..\n + "(|>> (list\map int\encode) (interposed '' '') (fold text\compose ''''))" ..\n "... =>" ..\n - "(function (_ ) (fold text\compose '''' (interpose '' '' (list\map int\encode ))))"))} + "(function (_ ) (fold text\compose '''' (interposed '' '' (list\map int\encode ))))"))} (do meta_monad - [g!_ (gensym "_") - g!arg (gensym "arg")] + [g!_ (..identifier "_") + g!arg (..identifier "arg")] (in_meta (list (` (function ((~ g!_) (~ g!arg)) (|> (~ g!arg) (~+ tokens)))))))) (macro: .public (<<| 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." ..\n - "(<<| (fold text\compose '''') (interpose '' '') (list\map int\encode))" ..\n + "(<<| (fold text\compose '''') (interposed '' '') (list\map int\encode))" ..\n "... =>" ..\n - "(function (_ ) (fold text\compose '''' (interpose '' '' (list\map int\encode ))))"))} + "(function (_ ) (fold text\compose '''' (interposed '' '' (list\map int\encode ))))"))} (do meta_monad - [g!_ (gensym "_") - g!arg (gensym "arg")] + [g!_ (..identifier "_") + g!arg (..identifier "arg")] (in_meta (list (` (function ((~ g!_) (~ g!arg)) (<| (~+ tokens) (~ g!arg)))))))) (def: (imported_by? import_name module_name) @@ -4661,7 +4661,7 @@ (failure ($_ text\compose "Wrong syntax for refer @ " current_module ..\n (|> options (list\map code\encode) - (interpose " ") + (list\interposed " ") (list\fold text\compose ""))))))) (def: (referral_definitions module_name [r_defs r_opens]) @@ -4831,7 +4831,7 @@ (: (-> [Name [Nat Type]] (Meta [Name Nat Code])) (function (_ [r_slot_name [r_idx r_type]]) (do meta_monad - [g!slot (gensym "")] + [g!slot (..identifier "")] (in_meta [r_slot_name r_idx g!slot])))) (zipped/2 tags (enumeration members)))] (let [pattern (record$ (list\map (: (-> [Name Nat Code] [Code Code]) @@ -4860,7 +4860,7 @@ (do meta_monad [bindings (monad\map meta_monad (: (-> Code (Meta Code)) - (function (_ _) (gensym "temp"))) + (function (_ _) (..identifier "temp"))) slots) .let [pairs (zipped/2 slots bindings) update_expr (list\fold (: (-> [Code Code] Code Code) @@ -4880,16 +4880,16 @@ (^ (list selector value)) (do meta_monad - [g!_ (gensym "_") - g!record (gensym "record")] + [g!_ (..identifier "_") + g!record (..identifier "record")] (in (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")] + [g!_ (..identifier "_") + g!value (..identifier "value") + g!record (..identifier "record")] (in (list (` (function ((~ g!_) (~ g!value) (~ g!record)) (..set@ (~ selector) (~ g!value) (~ g!record))))))) @@ -4920,7 +4920,7 @@ (: (-> [Name [Nat Type]] (Meta [Name Nat Code])) (function (_ [r_slot_name [r_idx r_type]]) (do meta_monad - [g!slot (gensym "")] + [g!slot (..identifier "")] (in_meta [r_slot_name r_idx g!slot])))) (zipped/2 tags (enumeration members)))] (let [pattern (record$ (list\map (: (-> [Name Nat Code] [Code Code]) @@ -4947,24 +4947,24 @@ _ (do meta_monad - [g!record (gensym "record") - g!temp (gensym "temp")] + [g!record (..identifier "record") + g!temp (..identifier "temp")] (in (list (` (let [(~ g!record) (~ record) (~ g!temp) (get@ [(~+ slots)] (~ g!record))] (set@ [(~+ slots)] ((~ fun) (~ g!temp)) (~ g!record)))))))) (^ (list selector fun)) (do meta_monad - [g!_ (gensym "_") - g!record (gensym "record")] + [g!_ (..identifier "_") + g!record (..identifier "record")] (in (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")] + [g!_ (..identifier "_") + g!fun (..identifier "fun") + g!record (..identifier "record")] (in (list (` (function ((~ g!_) (~ g!fun) (~ g!record)) (..update@ (~ selector) (~ g!fun) (~ g!record))))))) @@ -5019,7 +5019,7 @@ (if (every? (|>> ("lux i64 =" num_bindings)) (list\map list\size data')) (let [apply (: (-> Replacement_Environment (List Code)) - (function (_ env) (list\map (apply_template env) templates)))] + (function (_ env) (list\map (realized_template env) templates)))] (|> data' (list\map (compose apply (replacement_environment bindings'))) list\join @@ -5106,11 +5106,11 @@ (-> Text Nat) ("lux text size" x)) -(def: (update_location [file line column] code_text) +(def: (updated_location [file line column] code_text) (-> Location Text Location) [file line ("lux i64 +" column (text\size code_text))]) -(def: (delim_update_location [file line column]) +(def: (delimiter_updated_location [file line column]) (-> Location Location) [file line (inc column)]) @@ -5129,7 +5129,7 @@ (^template [ ] [[new_location ( value)] (let [as_text ( value)] - [(update_location new_location as_text) + [(updated_location new_location as_text) (text\compose (location_padding baseline prev_location new_location) as_text)])]) ([#Bit bit\encode] @@ -5145,9 +5145,9 @@ (let [[group_location' parts_text] (list\fold (function (_ part [last_location text_accum]) (let [[part_location part_text] (example_documentation last_location baseline part)] [part_location (text\compose text_accum part_text)])) - [(delim_update_location group_location) ""] + [(delimiter_updated_location group_location) ""] ( parts))] - [(delim_update_location group_location') + [(delimiter_updated_location group_location') ($_ text\compose (location_padding baseline prev_location group_location) parts_text @@ -5179,18 +5179,18 @@ [_ text] (..example_documentation (with_baseline baseline location) baseline example)] (text\compose text __paragraph)))) -(macro: .public (doc tokens) +(macro: .public (example tokens) {#.doc (text$ ($_ "lux text concat" "... Creates code documentation, embedding text as comments and properly formatting the forms it's being given." __paragraph "... 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)))"))} + "(example ''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)))"))} (in_meta (list (` [(~ location_code) (#.Text (~ (|> tokens (list\map (|>> ..documentation_fragment ..fragment_documentation)) @@ -5243,21 +5243,21 @@ (identifier$ [module name]))) (macro: .public (loop tokens) - {#.doc (doc "Allows arbitrary looping, using the 'recur' form to re-start the loop." - "Can be used in monadic code to create monadic loops." - (loop [count +0 + {#.doc (example "Allows arbitrary looping, using the 'recur' form to re-start the loop." + "Can be used in monadic code to create monadic loops." + (loop [count +0 + x init] + (if (< +10 count) + (recur (inc count) (f x)) + x)) + + "Loops can also be given custom names." + (loop my_loop + [count +0 x init] - (if (< +10 count) - (recur (inc count) (f x)) - x)) - - "Loops can also be given custom names." - (loop my_loop - [count +0 - x init] - (if (< +10 count) - (my_loop (inc count) (f x)) - x)))} + (if (< +10 count) + (my_loop (inc count) (f x)) + x)))} (let [?params (case tokens (^ (list name [_ (#Tuple bindings)] body)) (#.Some [name bindings body]) @@ -5289,7 +5289,7 @@ (do meta_monad [aliases (monad\map meta_monad (: (-> Code (Meta Code)) - (function (_ _) (gensym ""))) + (function (_ _) (..identifier ""))) inits)] (in_meta (list (` (let [(~+ (..interleaved aliases inits))] (.loop (~ name) @@ -5300,10 +5300,10 @@ (failure "Wrong syntax for loop")))) (macro: .public (^slots tokens) - {#.doc (doc "Allows you to extract record members as local variables with the same names." - "For example:" - (let [(^slots [#foo #bar #baz]) quux] - (f foo bar baz)))} + {#.doc (example "Allows you to extract record members as local variables with the same names." + "For example:" + (let [(^slots [#foo #bar #baz]) quux] + (f foo bar baz)))} (case tokens (^ (list& [_ (#Form (list [_ (#Tuple (list& hslot' tslots'))]))] body branches)) (do meta_monad @@ -5322,7 +5322,7 @@ hslot (..normal hslot) tslots (monad\map meta_monad ..normal tslots) output (..type_tag hslot) - g!_ (gensym "_") + g!_ (..identifier "_") .let [[idx tags exported? type] output slot_pairings (list\map (: (-> Name [Text Code]) (function (_ [module name]) @@ -5378,25 +5378,25 @@ (in (list [location (#Record =pairs)]))))) (macro: .public (with_expansions tokens) - {#.doc (doc "Controlled macro-expansion." - "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 & implementations" - (with_expansions - [ (template [ ] - [(compare (\ Code/encode encode ))] - - [(bit #1) "#1"] - [(int +123) "+123"] - [(frac +123.0) "+123.0"] - [(text "123") "'123'"] - [(tag ["yolo" "lol"]) "#yolo.lol"] - [(identifier ["yolo" "lol"]) "yolo.lol"] - [(form (list (bit #1))) "(#1)"] - [(tuple (list (bit #1))) "[#1]"] - [(record (list [(bit #1) (int +123)])) "{#1 +123}"] - )] - (test_all ))))} + {#.doc (example "Controlled macro-expansion." + "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 & implementations" + (with_expansions + [ (template [ ] + [(compare (\ Code/encode encode ))] + + [(bit #1) "#1"] + [(int +123) "+123"] + [(frac +123.0) "+123.0"] + [(text "123") "'123'"] + [(tag ["yolo" "lol"]) "#yolo.lol"] + [(identifier ["yolo" "lol"]) "yolo.lol"] + [(form (list (bit #1))) "(#1)"] + [(tuple (list (bit #1))) "[#1]"] + [(record (list [(bit #1) (int +123)])) "{#1 +123}"] + )] + (test_all ))))} (case tokens (^ (list& [_ (#Tuple bindings)] bodies)) (case bindings @@ -5550,26 +5550,26 @@ (list init_pattern inner_pattern_body))) (macro: .public (^multi tokens) - {#.doc (doc "Multi-level pattern matching." - "Useful in situations where the result of a branch depends on further refinements on the values being matched." - "For example:" - (case (split (size static) uri) - (^multi (#.Some [chunk uri']) - {(text\= static chunk) #1}) - (match_uri endpoint? parts' uri') + {#.doc (example "Multi-level pattern matching." + "Useful in situations where the result of a branch depends on further refinements on the values being matched." + "For example:" + (case (split (size static) uri) + (^multi (#.Some [chunk uri']) + {(text\= static chunk) #1}) + (match_uri endpoint? parts' uri') - _ - (#.Left (format "Static part " (%t static) " does not match URI: " uri))) + _ + (#.Left (format "Static part " (%t static) " does not match URI: " uri))) - "Short-cuts can be taken when using bit tests." - "The example above can be rewritten as..." - (case (split (size static) uri) - (^multi (#.Some [chunk uri']) - (text\= static chunk)) - (match_uri endpoint? parts' uri') + "Short-cuts can be taken when using bit tests." + "The example above can be rewritten as..." + (case (split (size static) uri) + (^multi (#.Some [chunk uri']) + (text\= static chunk)) + (match_uri endpoint? parts' uri') - _ - (#.Left (format "Static part " (%t static) " does not match URI: " uri))))} + _ + (#.Left (format "Static part " (%t static) " does not match URI: " uri))))} (case tokens (^ (list& [_meta (#Form levels)] body next_branches)) (do meta_monad @@ -5581,7 +5581,7 @@ _ #0)] expected get_expected_type - g!temp (gensym "temp")] + g!temp (..identifier "temp")] (let [output (list g!temp (` ({(#Some (~ g!temp)) (~ g!temp) @@ -5610,10 +5610,10 @@ (text\compose "Wrong syntax for "))) (macro: .public (name_of tokens) - {#.doc (doc "Given an identifier or a tag, gives back a 2 tuple with the module and name parts, both as Text." - (name_of #.doc) - "=>" - ["library/lux" "doc"])} + {#.doc (example "Given an identifier or a tag, gives back a 2 tuple with the module and name parts, both as Text." + (name_of #.doc) + "=>" + ["library/lux" "doc"])} (case tokens (^template [] [(^ (list [_ ( [module name])])) @@ -5634,14 +5634,14 @@ )) (macro: .public (:parameter tokens) - {#.doc (doc "Allows you to refer to the type-variables in a polymorphic function's type, by their index." - "In the example below, 0 corresponds to the 'a' variable." - (def: .public (of_list list) - (All [a] (-> (List a) (Row a))) - (list\fold add - (: (Row (:parameter 0)) - empty) - list)))} + {#.doc (example "Allows you to refer to the type-variables in a polymorphic function's type, by their index." + "In the example below, 0 corresponds to the 'a' variable." + (def: .public (of_list list) + (All [a] (-> (List a) (Row a))) + (list\fold add + (: (Row (:parameter 0)) + empty) + list)))} (case tokens (^ (list [_ (#Nat idx)])) (do meta_monad @@ -5657,22 +5657,22 @@ (failure (..wrong_syntax_error (name_of ..$))))) (def: .public (is? reference sample) - {#.doc (doc "Tests whether the 2 values are identical (not just 'equal')." - "This one should succeed:" - (let [value +5] - (is? value value)) + {#.doc (example "Tests whether the 2 values are identical (not just 'equal')." + "This one should succeed:" + (let [value +5] + (is? value value)) - "This one should fail:" - (is? +5 (+ +2 +3)))} + "This one should fail:" + (is? +5 (+ +2 +3)))} (All [a] (-> a a Bit)) ("lux is" reference sample)) (macro: .public (^@ tokens) - {#.doc (doc "Allows you to simultaneously bind and de-structure a value." - (def: (hash (^@ set [Hash _])) - (list\fold (function (_ elem acc) (+ (\ Hash hash elem) acc)) - 0 - (to_list set))))} + {#.doc (example "Allows you to simultaneously bind and de-structure a value." + (def: (hash (^@ set [Hash _])) + (list\fold (function (_ elem acc) (+ (\ Hash hash elem) acc)) + 0 + (to_list set))))} (case tokens (^ (list& [_meta (#Form (list [_ (#Identifier ["" name])] pattern))] body branches)) (let [g!whole (local_identifier$ name)] @@ -5684,10 +5684,10 @@ (failure (..wrong_syntax_error (name_of ..^@))))) (macro: .public (^|> tokens) - {#.doc (doc "Pipes the value being pattern-matched against prior to binding it to a variable." - (case input - (^|> value [inc (% 10) (max 1)]) - (foo value)))} + {#.doc (example "Pipes the value being pattern-matched against prior to binding it to a variable." + (case input + (^|> value [inc (% 10) (max 1)]) + (foo value)))} (case tokens (^ (list& [_meta (#Form (list [_ (#Identifier ["" name])] [_ (#Tuple steps)]))] body branches)) (let [g!name (local_identifier$ name)] @@ -5700,8 +5700,8 @@ (failure (..wrong_syntax_error (name_of ..^|>))))) (macro: .public (:assume tokens) - {#.doc (doc "Coerces the given expression to the type of whatever is expected." - (: Dinosaur (:assume (list +1 +2 +3))))} + {#.doc (example "Coerces the given expression to the type of whatever is expected." + (: Dinosaur (:assume (list +1 +2 +3))))} (case tokens (^ (list expr)) (do meta_monad @@ -5718,12 +5718,12 @@ (#Right [compiler (get@ #location compiler)]))) (macro: .public (undefined tokens) - {#.doc (doc "Meant to be used as a stand-in for functions with undefined implementations." - "Undefined expressions will type-check against everything, so they make good dummy implementations." - "However, if an undefined expression is ever evaluated, it will raise a runtime error." - (def: (square x) - (-> Int Int) - (undefined)))} + {#.doc (example "Meant to be used as a stand-in for functions with undefined implementations." + "Undefined expressions will type-check against everything, so they make good dummy implementations." + "However, if an undefined expression is ever evaluated, it will raise a runtime error." + (def: (square x) + (-> Int Int) + (undefined)))} (case tokens #End (do meta_monad @@ -5731,23 +5731,23 @@ .let [[module line column] location location ($_ "lux text concat" (text\encode module) "," (nat\encode line) "," (nat\encode column)) message ($_ "lux text concat" "Undefined behavior @ " location)]] - (in (list (` (..error! (~ (text$ message))))))) + (in (list (` (..panic! (~ (text$ message))))))) _ (failure (..wrong_syntax_error (name_of ..undefined))))) (macro: .public (:of tokens) - {#.doc (doc "Generates the type corresponding to a given expression." - "Example #1:" - (let [my_num +123] - (:of my_num)) - "==" - Int - "-------------------" - "Example #2:" - (:of +123) - "==" - Int)} + {#.doc (example "Generates the type corresponding to a given expression." + "Example #1:" + (let [my_num +123] + (:of my_num)) + "==" + Int + "-------------------" + "Example #2:" + (:of +123) + "==" + Int)} (case tokens (^ (list [_ (#Identifier var_name)])) (do meta_monad @@ -5756,7 +5756,7 @@ (^ (list expression)) (do meta_monad - [g!temp (gensym "g!temp")] + [g!temp (..identifier "g!temp")] (in (list (` (let [(~ g!temp) (~ expression)] (..:of (~ g!temp))))))) @@ -5804,16 +5804,16 @@ )) (macro: .public (template: tokens) - {#.doc (doc "Define macros in the style of template and ^template." - "For simple macros that do not need any fancy features." - (template: (square x) - (* x x)))} + {#.doc (example "Define macros in the style of template and ^template." + "For simple macros that do not need any fancy features." + (template: (square x) + (* x x)))} (case (templateP tokens) (#.Some [export_policy name args anns input_templates]) (do meta_monad - [g!tokens (gensym "tokens") - g!compiler (gensym "compiler") - g!_ (gensym "_") + [g!tokens (..identifier "tokens") + g!compiler (..identifier "compiler") + g!_ (..identifier "_") .let [rep_env (list\map (function (_ arg) [arg (` ((~' ~) (~ (local_identifier$ arg))))]) args)] @@ -5924,7 +5924,7 @@ (case code (^ [ann (#Form (list [_ (#Identifier ["" "~~"])] expansion))]) (do meta_monad - [g!expansion (gensym "g!expansion")] + [g!expansion (..identifier "g!expansion")] (in [(list [g!expansion expansion]) g!expansion])) (^template [] @@ -6015,7 +6015,7 @@ (def: (untemplated_pattern pattern) (-> Code (Meta Code)) (do meta_monad - [g!meta (gensym "g!meta")] + [g!meta (..identifier "g!meta")] (case pattern (^template [ ] [[_ ( value)] @@ -6035,9 +6035,9 @@ [_ (#Form (#Item [[_ (#Identifier ["" "~+"])] (#Item [spliced #End])]))] (failure "Cannot use (~+) inside of ^code unless it is the last element in a form or a tuple.") - (^template [ ] + (^template [ ] [[_ ( elems)] - ( g!meta untemplated_pattern elems)]) + ( g!meta untemplated_pattern elems)]) ([#.Tuple ..untemplated_tuple] [#.Form ..untemplated_form]) @@ -6084,16 +6084,16 @@ (..failure (..wrong_syntax_error (name_of ..:let))))) (macro: .public (try tokens) - {#.doc (doc (case (try (risky_computation input)) - (#.Right success) - (do_something success) + {#.doc (example (case (try (risky_computation input)) + (#.Right success) + (do_something success) - (#.Left error) - (recover_from_failure error)))} + (#.Left error) + (recover_from_failure error)))} (case tokens (^ (list expression)) (do meta_monad - [g!_ (gensym "g!_")] + [g!_ (..identifier "g!_")] (in (list (` ("lux try" (.function ((~ g!_) (~ g!_)) (~ expression))))))) -- cgit v1.2.3