diff options
Diffstat (limited to 'stdlib/source/library')
55 files changed, 736 insertions, 621 deletions
diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux index 84d33d03b..6f4d8071d 100644 --- a/stdlib/source/library/lux.lux +++ b/stdlib/source/library/lux.lux @@ -23,7 +23,7 @@ [dummy_location (9 #1 (0 #0))] #1) -## (type: Any +## (type: #export Any ## (Ex [a] a)) ("lux def" Any ("lux type check type" @@ -37,7 +37,7 @@ (0 #0)))] #1) -## (type: Nothing +## (type: #export Nothing ## (All [a] a)) ("lux def" Nothing ("lux type check type" @@ -51,7 +51,7 @@ (0 #0)))] #1) -## (type: (List a) +## (type: #export (List a) ## #End ## (#Item a (List a))) ("lux def type tagged" List @@ -156,7 +156,7 @@ #End))] #1) -## (type: (Maybe a) +## (type: #export (Maybe a) ## #None ## (#Some a)) ("lux def type tagged" Maybe @@ -175,7 +175,7 @@ ["None" "Some"] #1) -## (type: #rec Type +## (type: #export #rec Type ## (#Primitive Text (List Type)) ## (#Sum Type Type) ## (#Product Type Type) @@ -229,7 +229,7 @@ ["Primitive" "Sum" "Product" "Function" "Parameter" "Var" "Ex" "UnivQ" "ExQ" "Apply" "Named"] #1) -## (type: Location +## (type: #export Location ## {#module Text ## #line Nat ## #column Nat}) @@ -243,7 +243,7 @@ ["module" "line" "column"] #1) -## (type: (Ann m v) +## (type: #export (Ann m v) ## {#meta m ## #datum v}) ("lux def type tagged" Ann @@ -261,7 +261,7 @@ ["meta" "datum"] #1) -## (type: (Code' w) +## (type: #export (Code' w) ## (#Bit Bit) ## (#Nat Nat) ## (#Int Int) @@ -313,7 +313,7 @@ ["Bit" "Nat" "Int" "Rev" "Frac" "Text" "Identifier" "Tag" "Form" "Tuple" "Record"] #1) -## (type: Code +## (type: #export Code ## (Ann Location (Code' (Ann Location)))) ("lux def" Code (#Named ["library/lux" "Code"] @@ -414,7 +414,7 @@ [dummy_location (#Record #End)] #0) -## (type: Definition +## (type: #export Definition ## [Bit Type Code Any]) ("lux def" Definition ("lux type check type" @@ -425,7 +425,7 @@ #End)) #1) -## (type: Alias +## (type: #export Alias ## Name) ("lux def" Alias ("lux type check type" @@ -434,7 +434,7 @@ (record$ #End) #1) -## (type: Global +## (type: #export Global ## (#Alias Alias) ## (#Definition Definition)) ("lux def type tagged" Global @@ -447,7 +447,7 @@ ["Alias" "Definition"] #1) -## (type: (Bindings k v) +## (type: #export (Bindings k v) ## {#counter Nat ## #mappings (List [k v])}) ("lux def type tagged" Bindings @@ -479,7 +479,7 @@ ["Local" "Captured"] #1) -## (type: Scope +## (type: #export Scope ## {#name (List Text) ## #inner Nat ## #locals (Bindings Text [Type Nat]) @@ -504,7 +504,7 @@ (record$ #End) #0) -## (type: (Either l r) +## (type: #export (Either l r) ## (#Left l) ## (#Right r)) ("lux def type tagged" Either @@ -523,7 +523,7 @@ ["Left" "Right"] #1) -## (type: Source +## (type: #export Source ## [Location Nat Text]) ("lux def" Source ("lux type check type" @@ -532,7 +532,7 @@ (record$ #End) #1) -## (type: Module_State +## (type: #export Module_State ## #Active ## #Compiled ## #Cached) @@ -550,7 +550,7 @@ ["Active" "Compiled" "Cached"] #1) -## (type: Module +## (type: #export Module ## {#module_hash Nat ## #module_aliases (List [Text Text]) ## #definitions (List [Text Global]) @@ -592,7 +592,7 @@ ["module_hash" "module_aliases" "definitions" "imports" "tags" "types" "module_annotations" "module_state"] #1) -## (type: Type_Context +## (type: #export Type_Context ## {#ex_counter Nat ## #var_counter Nat ## #var_bindings (List [Nat (Maybe Type)])}) @@ -609,7 +609,7 @@ ["ex_counter" "var_counter" "var_bindings"] #1) -## (type: Mode +## (type: #export Mode ## #Build ## #Eval ## #Interpreter) @@ -627,7 +627,7 @@ ["Build" "Eval" "Interpreter"] #1) -## (type: Info +## (type: #export Info ## {#target Text ## #version Text ## #mode Mode}) @@ -647,7 +647,7 @@ ["target" "version" "mode"] #1) -## (type: Lux +## (type: #export Lux ## {#info Info ## #source Source ## #location Location @@ -696,7 +696,7 @@ ["info" "source" "location" "current_module" "modules" "scopes" "type_context" "expected" "seed" "scope_type_vars" "extensions" "host"] #1) -## (type: (Meta a) +## (type: #export (Meta a) ## (-> Lux (Either Text [Lux a]))) ("lux def" Meta ("lux type check type" @@ -714,7 +714,7 @@ #End))) #1) -## (type: Macro' +## (type: #export Macro' ## (-> (List Code) (Meta (List Code)))) ("lux def" Macro' ("lux type check type" @@ -723,7 +723,7 @@ (record$ #End) #1) -## (type: Macro +## (type: #export Macro ## (primitive "#Macro")) ("lux def" Macro ("lux type check type" @@ -993,16 +993,16 @@ (#Item (f x) (list\map f xs'))} xs)) -(def:'' RepEnv +(def:'' Replacement_Environment #End Type ($' List (#Product Text Code))) -(def:'' (make_env xs ys) +(def:'' (replacement_environment xs ys) #End - (#Function ($' List Text) (#Function ($' List Code) RepEnv)) + (#Function ($' List Text) (#Function ($' List Code) Replacement_Environment)) ({[(#Item x xs') (#Item y ys')] - (#Item [x y] (make_env xs' ys')) + (#Item [x y] (replacement_environment xs' ys')) _ #End} @@ -1013,43 +1013,43 @@ (#Function Text (#Function Text Bit)) ("lux text =" reference sample)) -(def:'' (get_rep key env) +(def:'' (replacement for environment) #End - (#Function Text (#Function RepEnv ($' Maybe Code))) + (#Function Text (#Function Replacement_Environment ($' Maybe Code))) ({#End #None - (#Item [k v] env') + (#Item [k v] environment') ({#1 (#Some v) #0 - (get_rep key env')} - (text\= k key))} - env)) + (replacement for environment')} + (text\= k for))} + environment)) -(def:'' (replace_syntax reps syntax) +(def:'' (with_replacements reps syntax) #End - (#Function RepEnv (#Function Code Code)) + (#Function Replacement_Environment (#Function Code Code)) ({[_ (#Identifier "" name)] ({(#Some replacement) replacement #None syntax} - (get_rep name reps)) + (..replacement name reps)) [meta (#Form parts)] - [meta (#Form (list\map (replace_syntax reps) parts))] + [meta (#Form (list\map (with_replacements reps) parts))] [meta (#Tuple members)] - [meta (#Tuple (list\map (replace_syntax reps) members))] + [meta (#Tuple (list\map (with_replacements reps) members))] [meta (#Record slots)] [meta (#Record (list\map ("lux type check" (#Function (#Product Code Code) (#Product Code Code)) (function'' [slot] ({[k v] - [(replace_syntax reps k) (replace_syntax reps v)]} + [(with_replacements reps k) (with_replacements reps v)]} slot))) slots))] @@ -1065,24 +1065,24 @@ ("lux type as" Int param) ("lux type as" Int subject)))) -(def:'' (update_parameters code) +(def:'' (nested_quantification code) #End (#Function Code Code) ({[_ (#Tuple members)] - (tuple$ (list\map update_parameters members)) + (tuple$ (list\map nested_quantification members)) [_ (#Record pairs)] (record$ (list\map ("lux type check" (#Function (#Product Code Code) (#Product Code Code)) (function'' [pair] (let'' [name val] pair - [name (update_parameters val)]))) + [name (nested_quantification val)]))) pairs)) [_ (#Form (#Item [_ (#Tag "library/lux" "Parameter")] (#Item [_ (#Nat idx)] #End)))] (form$ (#Item (tag$ ["library/lux" "Parameter"]) (#Item (nat$ ("lux i64 +" 2 idx)) #End))) [_ (#Form members)] - (form$ (list\map update_parameters members)) + (form$ (list\map nested_quantification members)) _ code} @@ -1105,7 +1105,7 @@ (failure "Expected identifier.")} args)) -(def:'' (make_parameter idx) +(def:'' (type_parameter idx) #End (#Function Nat Code) (form$ (#Item (tag$ ["library/lux" "Parameter"]) (#Item (nat$ idx) #End)))) @@ -1155,8 +1155,9 @@ (function'' [name' body'] (form$ (#Item (tag$ ["library/lux" "UnivQ"]) (#Item (tag$ ["library/lux" "End"]) - (#Item (replace_syntax (#Item [name' (make_parameter 1)] #End) - (update_parameters body')) #End)))))) + (#Item (with_replacements (#Item [name' (type_parameter 1)] #End) + (nested_quantification body')) + #End)))))) body names) (return (#Item ({[#1 _] @@ -1166,9 +1167,9 @@ body' [#0 _] - (replace_syntax (#Item [self_name (make_parameter (n/* 2 ("lux i64 -" 1 (list\size names))))] - #End) - body')} + (with_replacements (#Item [self_name (type_parameter (n/* 2 ("lux i64 -" 1 (list\size names))))] + #End) + body')} [(text\= "" self_name) names]) #End))))) @@ -1199,8 +1200,9 @@ (function'' [name' body'] (form$ (#Item (tag$ ["library/lux" "ExQ"]) (#Item (tag$ ["library/lux" "End"]) - (#Item (replace_syntax (#Item [name' (make_parameter 1)] #End) - (update_parameters body')) #End)))))) + (#Item (with_replacements (#Item [name' (type_parameter 1)] #End) + (nested_quantification body')) + #End)))))) body names) (return (#Item ({[#1 _] @@ -1210,9 +1212,9 @@ body' [#0 _] - (replace_syntax (#Item [self_name (make_parameter (n/* 2 ("lux i64 -" 1 (list\size names))))] - #End) - body')} + (with_replacements (#Item [self_name (type_parameter (n/* 2 ("lux i64 -" 1 (list\size names))))] + #End) + body')} [(text\= "" self_name) names]) #End))))) @@ -2069,14 +2071,14 @@ (def:''' (apply_template env template) #End - (-> RepEnv Code Code) + (-> Replacement_Environment Code Code) ({[_ (#Identifier "" sname)] ({(#Some subst) subst _ template} - (get_rep sname env)) + (..replacement sname env)) [meta (#Tuple elems)] [meta (#Tuple (list\map (apply_template env) elems))] @@ -2152,13 +2154,13 @@ " " "[dec -1]"))]) ({(#Item [[_ (#Tuple bindings)] (#Item [[_ (#Tuple templates)] data])]) ({[(#Some bindings') (#Some data')] - (let' [apply ("lux type check" (-> RepEnv ($' List Code)) + (let' [apply ("lux type check" (-> Replacement_Environment ($' List Code)) (function' [env] (list\map (apply_template env) templates))) num_bindings (list\size bindings')] (if (every? (function' [size] ("lux i64 =" num_bindings size)) (list\map list\size data')) (|> data' - (list\map (compose apply (make_env bindings'))) + (list\map (compose apply (replacement_environment bindings'))) list\join return) (failure "Irregular arguments tuples for template."))) @@ -2617,8 +2619,9 @@ "## A name has to be given to the whole type, to use it within its body." __paragraph "(Rec Self [Int (List Self)])"))]) ({(#Item [_ (#Identifier "" name)] (#Item body #End)) - (let' [body' (replace_syntax (list [name (` (#.Apply (~ (make_parameter 1)) (~ (make_parameter 0))))]) - (update_parameters body))] + (let' [body' (|> body + nested_quantification + (with_replacements (list [name (` (#.Apply (~ (type_parameter 1)) (~ (type_parameter 0))))])))] (return (list (` (#.Apply .Nothing (#.UnivQ #.End (~ body'))))))) _ @@ -3639,7 +3642,8 @@ (if (empty? args) (let [g!param (local_identifier$ "") prime_name (local_identifier$ name) - type+ (replace_syntax (list [name (` ((~ prime_name) .Nothing))]) type)] + type+ (with_replacements (list [name (` ((~ prime_name) .Nothing))]) + type)] (#Some (` ((All (~ prime_name) [(~ g!param)] (~ type+)) .Nothing)))) #None) @@ -4850,10 +4854,10 @@ (let [num_bindings (list\size bindings')] (if (every? (|>> ("lux i64 =" num_bindings)) (list\map list\size data')) - (let [apply (: (-> RepEnv (List Code)) + (let [apply (: (-> Replacement_Environment (List Code)) (function (_ env) (list\map (apply_template env) templates)))] (|> data' - (list\map (compose apply (make_env bindings'))) + (list\map (compose apply (replacement_environment bindings'))) list\join in)) #None)))) @@ -5460,13 +5464,13 @@ (#Right state scope_type_vars) )) -(macro: #export ($ tokens) +(macro: #export (: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: #export (of_list list) (All [a] (-> (List a) (Row a))) (list\fold add - (: (Row ($ 0)) + (: (Row (:parameter 0)) empty) list)))} (case tokens @@ -5678,7 +5682,8 @@ (^ (list (~+ (list\map local_identifier$ args)))) (#.Right [(~ g!compiler) (list (~+ (list\map (function (_ template) - (` (`' (~ (replace_syntax rep_env template))))) + (` (`' (~ (with_replacements rep_env + template))))) input_templates)))]) (~ g!_) diff --git a/stdlib/source/library/lux/control/exception.lux b/stdlib/source/library/lux/control/exception.lux index e7cdd6d3e..ac913de17 100644 --- a/stdlib/source/library/lux/control/exception.lux +++ b/stdlib/source/library/lux/control/exception.lux @@ -83,7 +83,7 @@ (All [e a] (-> (Exception e) e (Try a))) (#//.Failure (..construct exception message))) -(def: #export (assert exception message test) +(def: #export (assertion exception message test) (All [e] (-> (Exception e) e Bit (Try Any))) (if test (#//.Success []) diff --git a/stdlib/source/library/lux/control/parser.lux b/stdlib/source/library/lux/control/parser.lux index e8ba63499..b4169e2d5 100644 --- a/stdlib/source/library/lux/control/parser.lux +++ b/stdlib/source/library/lux/control/parser.lux @@ -69,7 +69,7 @@ (#try.Success [input' ma]) (ma input'))))) -(def: #export (assert message test) +(def: #export (assertion message test) {#.doc "Fails with the given message if the test is #0."} (All [s] (-> Text Bit (Parser s Any))) (function (_ input) @@ -284,7 +284,7 @@ (All [s a] (-> (-> a Bit) (Parser s a) (Parser s a))) (do ..monad [output parser - _ (..assert "Constraint failed." (test output))] + _ (..assertion "Constraint failed." (test output))] (in output))) (def: #export (parses? parser) diff --git a/stdlib/source/library/lux/control/parser/binary.lux b/stdlib/source/library/lux/control/parser/binary.lux index 6543cb954..66e2d6e77 100644 --- a/stdlib/source/library/lux/control/parser/binary.lux +++ b/stdlib/source/library/lux/control/parser/binary.lux @@ -240,9 +240,9 @@ (do //.monad [raw (..list value) #let [output (set.of_list hash raw)] - _ (//.assert (exception.construct ..set_elements_are_not_unique []) - (n.= (list.size raw) - (set.size output)))] + _ (//.assertion (exception.construct ..set_elements_are_not_unique []) + (n.= (list.size raw) + (set.size output)))] (in output))) (def: #export name diff --git a/stdlib/source/library/lux/control/parser/text.lux b/stdlib/source/library/lux/control/parser/text.lux index ce3aacdaf..767565fc5 100644 --- a/stdlib/source/library/lux/control/parser/text.lux +++ b/stdlib/source/library/lux/control/parser/text.lux @@ -175,9 +175,9 @@ (do //.monad [char any #let [char' (maybe.assume (/.nth 0 char))] - _ (//.assert ($_ /\compose "Character is not within range: " (/.of_code bottom) "-" (/.of_code top)) - (.and (n.>= bottom char') - (n.<= top char')))] + _ (//.assertion ($_ /\compose "Character is not within range: " (/.of_code bottom) "-" (/.of_code top)) + (.and (n.>= bottom char') + (n.<= top char')))] (in char))) (template [<name> <bottom> <top> <desc>] diff --git a/stdlib/source/library/lux/control/try.lux b/stdlib/source/library/lux/control/try.lux index c1a991628..0226bab08 100644 --- a/stdlib/source/library/lux/control/try.lux +++ b/stdlib/source/library/lux/control/try.lux @@ -102,8 +102,9 @@ ))) (def: #export (assumed try) - {#.doc (doc "Assumes a Try value succeeded." - "If it didn't, raises the error as a runtime error.")} + {#.doc (doc "Assumes a Try value succeeded, and yields its value." + "If it didn't, raises the error as a runtime error." + "WARNING: Use with caution.")} (All [a] (-> (Try a) a)) (case try (#Success value) diff --git a/stdlib/source/library/lux/control/writer.lux b/stdlib/source/library/lux/control/writer.lux index 066b4ef58..ee5c15ee8 100644 --- a/stdlib/source/library/lux/control/writer.lux +++ b/stdlib/source/library/lux/control/writer.lux @@ -65,7 +65,7 @@ (def: (join MlMla) (do monad [[l1 Mla] (for {@.old - (: (($ 1) (Writer ($ 0) (($ 1) (Writer ($ 0) ($ 2))))) + (: ((:parameter 1) (Writer (:parameter 0) ((:parameter 1) (Writer (:parameter 0) (:parameter 2))))) MlMla)} ## On new compiler MlMla) diff --git a/stdlib/source/library/lux/data/binary.lux b/stdlib/source/library/lux/data/binary.lux index 6cd8c722b..deec60d53 100644 --- a/stdlib/source/library/lux/data/binary.lux +++ b/stdlib/source/library/lux/data/binary.lux @@ -33,7 +33,10 @@ ["Offset" (%.nat offset)] ["Length" (%.nat length)])) -(with_expansions [<jvm> (as_is (type: #export Binary (ffi.type [byte])) +(with_expansions [<documentation> (as_is {#.doc (doc "A binary BLOB of data.")}) + <jvm> (as_is (type: #export Binary + <documentation> + (ffi.type [byte])) (ffi.import: java/lang/Object) @@ -75,14 +78,17 @@ (length ffi.Number)]) (type: #export Binary + <documentation> Uint8Array)) @.python (type: #export Binary + <documentation> (primitive "bytearray")) @.scheme (as_is (type: #export Binary + <documentation> (primitive "bytevector")) (ffi.import: (make-bytevector [Nat] Binary)) @@ -92,6 +98,7 @@ ## Default (type: #export Binary + <documentation> (array.Array (I64 Any))))) (template: (!size binary) @@ -114,167 +121,177 @@ ## Default (array.size binary))) -(template: (!read idx binary) - (for {@.old (..i64 (ffi.array_read idx binary)) - @.jvm (..i64 (ffi.array_read idx binary)) +(template: (!read index binary) + (for {@.old (..i64 (ffi.array_read index binary)) + @.jvm (..i64 (ffi.array_read index binary)) @.js (|> binary (: ..Binary) (:as (array.Array .Frac)) - ("js array read" idx) + ("js array read" index) f.nat .i64) @.python (|> binary (:as (array.Array .I64)) - ("python array read" idx)) + ("python array read" index)) @.scheme - (..bytevector-u8-ref [binary idx])} + (..bytevector-u8-ref [binary index])} ## Default (|> binary - (array.read idx) + (array.read index) (maybe.else (: (I64 Any) 0)) (:as I64)))) -(template: (!!write <byte_type> <post> <write> idx value binary) +(template: (!!write <byte_type> <post> <write> index value binary) (|> binary (: ..Binary) (:as (array.Array <byte_type>)) - (<write> idx (|> value .nat (n.% (hex "100")) <post>)) + (<write> index (|> value .nat (n.% (hex "100")) <post>)) (:as ..Binary))) -(template: (!write idx value binary) - (for {@.old (ffi.array_write idx (..byte value) binary) - @.jvm (ffi.array_write idx (..byte value) binary) +(template: (!write index value binary) + (for {@.old (ffi.array_write index (..byte value) binary) + @.jvm (ffi.array_write index (..byte value) binary) - @.js (!!write .Frac n.frac "js array write" idx value binary) - @.python (!!write (I64 Any) (:as (I64 Any)) "python array write" idx value binary) - @.scheme (exec (..bytevector-u8-set! [binary idx value]) + @.js (!!write .Frac n.frac "js array write" index value binary) + @.python (!!write (I64 Any) (:as (I64 Any)) "python array write" index value binary) + @.scheme (exec (..bytevector-u8-set! [binary index value]) binary)} ## Default - (array.write! idx (|> value .nat (n.% (hex "100"))) binary))) + (array.write! index (|> value .nat (n.% (hex "100"))) binary))) (def: #export size (-> Binary Nat) (|>> !size)) -(def: #export create +(def: #export (create size) + {#.doc (doc "A fresh/empty binary BLOB of the specified size.")} (-> Nat Binary) - (for {@.old (|>> (ffi.array byte)) - @.jvm (|>> (ffi.array byte)) + (for {@.old (ffi.array byte size) + @.jvm (ffi.array byte size) @.js - (|>> n.frac ArrayBuffer::new Uint8Array::new) + (|> size n.frac ArrayBuffer::new Uint8Array::new) @.python - (|>> ("python apply" (:as ffi.Function ("python constant" "bytearray"))) - (:as Binary)) + (|> size + ("python apply" (:as ffi.Function ("python constant" "bytearray"))) + (:as Binary)) @.scheme - (|>> ..make-bytevector)} + (..make-bytevector size)} ## Default - array.new)) + (array.new size))) (def: #export (fold f init binary) (All [a] (-> (-> I64 a a) a Binary a)) (let [size (..!size binary)] - (loop [idx 0 + (loop [index 0 output init] - (if (n.< size idx) - (recur (inc idx) (f (!read idx binary) output)) + (if (n.< size index) + (recur (inc index) (f (!read index binary) output)) output)))) -(def: #export (read/8 idx binary) +(def: #export (read/8 index binary) + {#.doc (doc "Read 1 byte (8 bits) at the given index.")} (-> Nat Binary (Try I64)) - (if (n.< (..!size binary) idx) - (#try.Success (!read idx binary)) - (exception.except ..index_out_of_bounds [(..!size binary) idx]))) + (if (n.< (..!size binary) index) + (#try.Success (!read index binary)) + (exception.except ..index_out_of_bounds [(..!size binary) index]))) -(def: #export (read/16 idx binary) +(def: #export (read/16 index binary) + {#.doc (doc "Read 2 bytes (16 bits) at the given index.")} (-> Nat Binary (Try I64)) - (if (n.< (..!size binary) (n.+ 1 idx)) + (if (n.< (..!size binary) (n.+ 1 index)) (#try.Success ($_ i64.or - (i64.left_shifted 8 (!read idx binary)) - (!read (n.+ 1 idx) binary))) - (exception.except ..index_out_of_bounds [(..!size binary) idx]))) + (i64.left_shifted 8 (!read index binary)) + (!read (n.+ 1 index) binary))) + (exception.except ..index_out_of_bounds [(..!size binary) index]))) -(def: #export (read/32 idx binary) +(def: #export (read/32 index binary) + {#.doc (doc "Read 4 bytes (32 bits) at the given index.")} (-> Nat Binary (Try I64)) - (if (n.< (..!size binary) (n.+ 3 idx)) + (if (n.< (..!size binary) (n.+ 3 index)) (#try.Success ($_ i64.or - (i64.left_shifted 24 (!read idx binary)) - (i64.left_shifted 16 (!read (n.+ 1 idx) binary)) - (i64.left_shifted 8 (!read (n.+ 2 idx) binary)) - (!read (n.+ 3 idx) binary))) - (exception.except ..index_out_of_bounds [(..!size binary) idx]))) - -(def: #export (read/64 idx binary) + (i64.left_shifted 24 (!read index binary)) + (i64.left_shifted 16 (!read (n.+ 1 index) binary)) + (i64.left_shifted 8 (!read (n.+ 2 index) binary)) + (!read (n.+ 3 index) binary))) + (exception.except ..index_out_of_bounds [(..!size binary) index]))) + +(def: #export (read/64 index binary) + {#.doc (doc "Read 8 bytes (64 bits) at the given index.")} (-> Nat Binary (Try I64)) - (if (n.< (..!size binary) (n.+ 7 idx)) + (if (n.< (..!size binary) (n.+ 7 index)) (#try.Success ($_ i64.or - (i64.left_shifted 56 (!read idx binary)) - (i64.left_shifted 48 (!read (n.+ 1 idx) binary)) - (i64.left_shifted 40 (!read (n.+ 2 idx) binary)) - (i64.left_shifted 32 (!read (n.+ 3 idx) binary)) - (i64.left_shifted 24 (!read (n.+ 4 idx) binary)) - (i64.left_shifted 16 (!read (n.+ 5 idx) binary)) - (i64.left_shifted 8 (!read (n.+ 6 idx) binary)) - (!read (n.+ 7 idx) binary))) - (exception.except ..index_out_of_bounds [(..!size binary) idx]))) - -(def: #export (write/8 idx value binary) + (i64.left_shifted 56 (!read index binary)) + (i64.left_shifted 48 (!read (n.+ 1 index) binary)) + (i64.left_shifted 40 (!read (n.+ 2 index) binary)) + (i64.left_shifted 32 (!read (n.+ 3 index) binary)) + (i64.left_shifted 24 (!read (n.+ 4 index) binary)) + (i64.left_shifted 16 (!read (n.+ 5 index) binary)) + (i64.left_shifted 8 (!read (n.+ 6 index) binary)) + (!read (n.+ 7 index) binary))) + (exception.except ..index_out_of_bounds [(..!size binary) index]))) + +(def: #export (write/8 index value binary) + {#.doc (doc "Write 1 byte (8 bits) at the given index.")} (-> Nat (I64 Any) Binary (Try Binary)) - (if (n.< (..!size binary) idx) + (if (n.< (..!size binary) index) (#try.Success (|> binary - (!write idx value))) - (exception.except ..index_out_of_bounds [(..!size binary) idx]))) + (!write index value))) + (exception.except ..index_out_of_bounds [(..!size binary) index]))) -(def: #export (write/16 idx value binary) +(def: #export (write/16 index value binary) + {#.doc (doc "Write 2 bytes (16 bits) at the given index.")} (-> Nat (I64 Any) Binary (Try Binary)) - (if (n.< (..!size binary) (n.+ 1 idx)) + (if (n.< (..!size binary) (n.+ 1 index)) (#try.Success (|> binary - (!write idx (i64.right_shifted 8 value)) - (!write (n.+ 1 idx) value))) - (exception.except ..index_out_of_bounds [(..!size binary) idx]))) + (!write index (i64.right_shifted 8 value)) + (!write (n.+ 1 index) value))) + (exception.except ..index_out_of_bounds [(..!size binary) index]))) -(def: #export (write/32 idx value binary) +(def: #export (write/32 index value binary) + {#.doc (doc "Write 4 bytes (32 bits) at the given index.")} (-> Nat (I64 Any) Binary (Try Binary)) - (if (n.< (..!size binary) (n.+ 3 idx)) + (if (n.< (..!size binary) (n.+ 3 index)) (#try.Success (|> binary - (!write idx (i64.right_shifted 24 value)) - (!write (n.+ 1 idx) (i64.right_shifted 16 value)) - (!write (n.+ 2 idx) (i64.right_shifted 8 value)) - (!write (n.+ 3 idx) value))) - (exception.except ..index_out_of_bounds [(..!size binary) idx]))) - -(def: #export (write/64 idx value binary) + (!write index (i64.right_shifted 24 value)) + (!write (n.+ 1 index) (i64.right_shifted 16 value)) + (!write (n.+ 2 index) (i64.right_shifted 8 value)) + (!write (n.+ 3 index) value))) + (exception.except ..index_out_of_bounds [(..!size binary) index]))) + +(def: #export (write/64 index value binary) + {#.doc (doc "Write 8 bytes (64 bits) at the given index.")} (-> Nat (I64 Any) Binary (Try Binary)) - (if (n.< (..!size binary) (n.+ 7 idx)) - (for {@.scheme (let [write_high (|>> (!write idx (i64.right_shifted 56 value)) - (!write (n.+ 1 idx) (i64.right_shifted 48 value)) - (!write (n.+ 2 idx) (i64.right_shifted 40 value)) - (!write (n.+ 3 idx) (i64.right_shifted 32 value))) - write_low (|>> (!write (n.+ 4 idx) (i64.right_shifted 24 value)) - (!write (n.+ 5 idx) (i64.right_shifted 16 value)) - (!write (n.+ 6 idx) (i64.right_shifted 8 value)) - (!write (n.+ 7 idx) value))] + (if (n.< (..!size binary) (n.+ 7 index)) + (for {@.scheme (let [write_high (|>> (!write index (i64.right_shifted 56 value)) + (!write (n.+ 1 index) (i64.right_shifted 48 value)) + (!write (n.+ 2 index) (i64.right_shifted 40 value)) + (!write (n.+ 3 index) (i64.right_shifted 32 value))) + write_low (|>> (!write (n.+ 4 index) (i64.right_shifted 24 value)) + (!write (n.+ 5 index) (i64.right_shifted 16 value)) + (!write (n.+ 6 index) (i64.right_shifted 8 value)) + (!write (n.+ 7 index) value))] (|> binary write_high write_low #try.Success))} (#try.Success (|> binary - (!write idx (i64.right_shifted 56 value)) - (!write (n.+ 1 idx) (i64.right_shifted 48 value)) - (!write (n.+ 2 idx) (i64.right_shifted 40 value)) - (!write (n.+ 3 idx) (i64.right_shifted 32 value)) - (!write (n.+ 4 idx) (i64.right_shifted 24 value)) - (!write (n.+ 5 idx) (i64.right_shifted 16 value)) - (!write (n.+ 6 idx) (i64.right_shifted 8 value)) - (!write (n.+ 7 idx) value)))) - (exception.except ..index_out_of_bounds [(..!size binary) idx]))) + (!write index (i64.right_shifted 56 value)) + (!write (n.+ 1 index) (i64.right_shifted 48 value)) + (!write (n.+ 2 index) (i64.right_shifted 40 value)) + (!write (n.+ 3 index) (i64.right_shifted 32 value)) + (!write (n.+ 4 index) (i64.right_shifted 24 value)) + (!write (n.+ 5 index) (i64.right_shifted 16 value)) + (!write (n.+ 6 index) (i64.right_shifted 8 value)) + (!write (n.+ 7 index) value)))) + (exception.except ..index_out_of_bounds [(..!size binary) index]))) (implementation: #export equivalence (Equivalence Binary) @@ -286,11 +303,11 @@ (let [limit (!size reference)] (and (n.= limit (!size sample)) - (loop [idx 0] - (if (n.< limit idx) - (and (n.= (!read idx reference) - (!read idx sample)) - (recur (inc idx))) + (loop [index 0] + (if (n.< limit index) + (and (n.= (!read index reference) + (!read index sample)) + (recur (inc index))) true)))))))) (for {@.old (as_is) @@ -306,6 +323,7 @@ ["Target output space" (%.nat target_output)]))) (def: #export (copy bytes source_offset source target_offset target) + {#.doc (doc "Mutates the target binary BLOB by copying bytes from the source BLOB to it.")} (-> Nat Nat Binary Nat Binary (Try Binary)) (with_expansions [<jvm> (as_is (do try.monad [_ (java/lang/System::arraycopy source (.int source_offset) target (.int target_offset) (.int bytes))] @@ -316,35 +334,37 @@ ## Default (let [source_input (n.- source_offset (!size source)) target_output (n.- target_offset (!size target))] - (if (n.<= source_input bytes) - (loop [idx 0] - (if (n.< bytes idx) - (exec (!write (n.+ target_offset idx) - (!read (n.+ source_offset idx) source) + (if (n.> source_input bytes) + (exception.except ..cannot_copy_bytes [bytes source_input target_output]) + (loop [index 0] + (if (n.< bytes index) + (exec (!write (n.+ target_offset index) + (!read (n.+ source_offset index) source) target) - (recur (inc idx))) - (#try.Success target))) - (exception.except ..cannot_copy_bytes [bytes source_input target_output])))))) + (recur (inc index))) + (#try.Success target)))))))) (def: #export (slice offset length binary) + {#.doc (doc "Yields a subset of the binary BLOB, so long as the specified range is valid.")} (-> Nat Nat Binary (Try Binary)) (let [size (..!size binary) limit (n.+ length offset)] - (if (n.<= size limit) + (if (n.> size limit) + (exception.except ..slice_out_of_bounds [size offset length]) (with_expansions [<jvm> (as_is (#try.Success (java/util/Arrays::copyOfRange binary (.int offset) (.int limit))))] (for {@.old <jvm> @.jvm <jvm>} ## Default - (..copy length offset binary 0 (..create length)))) - (exception.except ..slice_out_of_bounds [size offset length])))) + (..copy length offset binary 0 (..create length))))))) -(def: #export (drop offset binary) +(def: #export (drop bytes binary) + {#.doc (doc "Yields a binary BLOB with at most the specified number of bytes removed.")} (-> Nat Binary Binary) - (case offset + (case bytes 0 binary - _ (let [distance (n.- offset (..!size binary))] - (case (..slice offset distance binary) + _ (let [distance (n.- bytes (..!size binary))] + (case (..slice bytes distance binary) (#try.Success slice) slice diff --git a/stdlib/source/library/lux/data/bit.lux b/stdlib/source/library/lux/data/bit.lux index 05d419b8f..5de3cf526 100644 --- a/stdlib/source/library/lux/data/bit.lux +++ b/stdlib/source/library/lux/data/bit.lux @@ -4,7 +4,7 @@ [abstract [monoid (#+ Monoid)] [equivalence (#+ Equivalence)] - hash + [hash (#+ Hash)] [codec (#+ Codec)]] [control ["." function]]]]) diff --git a/stdlib/source/library/lux/data/collection/list.lux b/stdlib/source/library/lux/data/collection/list.lux index a584f9363..f5d6dcf02 100644 --- a/stdlib/source/library/lux/data/collection/list.lux +++ b/stdlib/source/library/lux/data/collection/list.lux @@ -600,7 +600,7 @@ [lMla MlMla ## TODO: Remove this version ASAP and use one below. lla (for {@.old - (: (($ 0) (List (List ($ 1)))) + (: ((:parameter 0) (List (List (:parameter 1)))) (monad.seq ! lMla))} (monad.seq ! lMla))] (in (concat lla))))) diff --git a/stdlib/source/library/lux/data/collection/row.lux b/stdlib/source/library/lux/data/collection/row.lux index b5bbcbe30..7ce9802d6 100644 --- a/stdlib/source/library/lux/data/collection/row.lux +++ b/stdlib/source/library/lux/data/collection/row.lux @@ -218,7 +218,7 @@ ## 1-level taller. (|> row (set@ #root (|> (for {@.old - (: (Hierarchy ($ 0)) + (: (Hierarchy (:parameter 0)) (new_hierarchy []))} (new_hierarchy [])) (array.write! 0 (#Hierarchy (get@ #root row))) @@ -285,7 +285,7 @@ (if (within_bounds? row idx) (#try.Success (if (n.>= (tail_off row_size) idx) (update@ #tail (for {@.old - (: (-> (Base ($ 0)) (Base ($ 0))) + (: (-> (Base (:parameter 0)) (Base (:parameter 0))) (|>> array.clone (array.write! (branch_idx idx) val)))} (|>> array.clone (array.write! (branch_idx idx) val))) row) diff --git a/stdlib/source/library/lux/data/collection/tree/zipper.lux b/stdlib/source/library/lux/data/collection/tree/zipper.lux index 4c1def087..45e3a109e 100644 --- a/stdlib/source/library/lux/data/collection/tree/zipper.lux +++ b/stdlib/source/library/lux/data/collection/tree/zipper.lux @@ -102,7 +102,8 @@ [family (get@ #family zipper)] (in (let [(^slots [#parent #lefts #rights]) family] (for {@.old - (update@ #node (: (-> (Tree ($ 0)) (Tree ($ 0))) + (update@ #node (: (-> (Tree (:parameter 0)) + (Tree (:parameter 0))) (set@ #//.children (list\compose (list.reverse lefts) (#.Item (get@ #node zipper) rights)))) diff --git a/stdlib/source/library/lux/data/color.lux b/stdlib/source/library/lux/data/color.lux index 325d94db0..482b6435d 100644 --- a/stdlib/source/library/lux/data/color.lux +++ b/stdlib/source/library/lux/data/color.lux @@ -5,9 +5,18 @@ [equivalence (#+ Equivalence)] [monoid (#+ Monoid)] ["." hash (#+ Hash)]] + [control + [parser + ["<.>" code]]] [data + ["." text + ["%" format (#+ format)]] [collection ["." list ("#\." functor)]]] + [macro + [syntax (#+ syntax:)] + ["." template] + ["." code]] ["." math [number ["n" nat] @@ -21,7 +30,8 @@ (def: rgb 256) (def: top (dec rgb)) -(def: rgb_factor (|> top .int int.frac)) +(def: rgb_factor + (|> top .int int.frac)) (def: down (-> Nat Frac) @@ -32,25 +42,31 @@ (|>> (f.* rgb_factor) f.int .nat)) (type: #export RGB + {#.doc (doc "Red-Green-Blue color format.")} {#red Nat #green Nat #blue Nat}) (type: #export HSL + {#.doc (doc "Hue-Saturation-Lightness color format.")} [Frac Frac Frac]) (type: #export CMYK + {#.doc (doc "Cyan-Magenta-Yellow-Key color format.")} {#cyan Frac #magenta Frac #yellow Frac #key Frac}) (type: #export HSB + {#.doc (doc "Hue-Saturation-Brightness color format.")} [Frac Frac Frac]) (abstract: #export Color RGB + {#.doc (doc "A color value, independent of color format.")} + (def: #export (of_rgb [red green blue]) (-> RGB Color) (:abstraction {#red (n.% ..rgb red) @@ -84,11 +100,13 @@ b)))) (def: #export black + Color (..of_rgb {#red 0 #green 0 #blue 0})) (def: #export white + Color (..of_rgb {#red ..top #green ..top #blue ..top})) @@ -110,6 +128,7 @@ (|> ..top (n.- value))) (def: #export (complement color) + {#.doc (doc "The opposite color.")} (-> Color Color) (let [[red green blue] (:representation color)] (:abstraction {#red (complement' red) @@ -316,11 +335,11 @@ (-> Frac Color Color) (..interpolate ratio <target> color))] - [darker black] - [brighter white] + [darker ..black] + [brighter ..white] ) -(template [<name> <op>] +(template [<op> <name>] [(def: #export (<name> ratio color) (-> Frac Color Color) (let [[hue saturation luminance] (to_hsl color)] @@ -330,8 +349,8 @@ (f.min +1.0)) luminance])))] - [saturate f.+] - [de_saturate f.-] + [f.+ saturate] + [f.- de_saturate] ) (def: #export (gray_scale color) @@ -341,17 +360,23 @@ +0.0 luminance]))) +(syntax: (color_scheme_documentation {name <code>.local_identifier}) + (let [name (text.replace_all "_" "-" name) + g!documentation (code.text (format "A " name " color scheme."))] + (in (list (` {#.doc (.doc (~ g!documentation))}))))) + (template [<name> <1> <2>] - [(def: #export (<name> color) - (-> Color [Color Color Color]) - (let [[hue saturation luminance] (to_hsl color)] - [color - (of_hsl [(|> hue (f.+ <1>) ..normal) - saturation - luminance]) - (of_hsl [(|> hue (f.+ <2>) ..normal) - saturation - luminance])]))] + [(`` (def: #export (<name> color) + (~~ (..color_scheme_documentation <name>)) + (-> Color [Color Color Color]) + (let [[hue saturation luminance] (to_hsl color)] + [color + (of_hsl [(|> hue (f.+ <1>) ..normal) + saturation + luminance]) + (of_hsl [(|> hue (f.+ <2>) ..normal) + saturation + luminance])])))] [triad (|> +1.0 (f./ +3.0)) (|> +2.0 (f./ +3.0))] [clash (|> +1.0 (f./ +4.0)) (|> +3.0 (f./ +4.0))] @@ -359,19 +384,20 @@ ) (template [<name> <1> <2> <3>] - [(def: #export (<name> color) - (-> Color [Color Color Color Color]) - (let [[hue saturation luminance] (to_hsb color)] - [color - (of_hsb [(|> hue (f.+ <1>) ..normal) - saturation - luminance]) - (of_hsb [(|> hue (f.+ <2>) ..normal) - saturation - luminance]) - (of_hsb [(|> hue (f.+ <3>) ..normal) - saturation - luminance])]))] + [(`` (def: #export (<name> color) + (~~ (..color_scheme_documentation <name>)) + (-> Color [Color Color Color Color]) + (let [[hue saturation luminance] (to_hsb color)] + [color + (of_hsb [(|> hue (f.+ <1>) ..normal) + saturation + luminance]) + (of_hsb [(|> hue (f.+ <2>) ..normal) + saturation + luminance]) + (of_hsb [(|> hue (f.+ <3>) ..normal) + saturation + luminance])])))] [square (|> +1.0 (f./ +4.0)) (|> +2.0 (f./ +4.0)) (|> +3.0 (f./ +4.0))] [tetradic (|> +2.0 (f./ +12.0)) (|> +6.0 (f./ +12.0)) (|> +8.0 (f./ +12.0))] @@ -383,43 +409,55 @@ (type: #export Palette (-> Spread Nat Color (List Color))) -(def: #export (analogous spread variations color) - (-> Spread Nat Color (List Color)) - (let [[hue saturation brightness] (to_hsb color) - spread (..normal spread)] - (list\map (function (_ idx) - (of_hsb [(|> idx inc .int int.frac (f.* spread) (f.+ hue) ..normal) - saturation - brightness])) - (list.indices variations)))) - -(def: #export (monochromatic spread variations color) - (-> Spread Nat Color (List Color)) - (let [[hue saturation brightness] (to_hsb color) - spread (..normal spread)] - (|> (list.indices variations) - (list\map (|>> inc .int int.frac - (f.* spread) - (f.+ brightness) - ..normal - [hue saturation] - of_hsb))))) +(syntax: (palette_documentation {name <code>.local_identifier}) + (let [name (text.replace_all "_" "-" name) + g!documentation (code.text (format "A " name " palette."))] + (in (list (` {#.doc (.doc (~ g!documentation))}))))) + +(`` (def: #export (analogous spread variations color) + (~~ (..palette_documentation analogous)) + Palette + (let [[hue saturation brightness] (to_hsb color) + spread (..normal spread)] + (list\map (function (_ idx) + (of_hsb [(|> idx inc .int int.frac (f.* spread) (f.+ hue) ..normal) + saturation + brightness])) + (list.indices variations))))) + +(`` (def: #export (monochromatic spread variations color) + (~~ (..palette_documentation monochromatic)) + Palette + (let [[hue saturation brightness] (to_hsb color) + spread (..normal spread)] + (|> (list.indices variations) + (list\map (|>> inc .int int.frac + (f.* spread) + (f.+ brightness) + ..normal + [hue saturation] + of_hsb)))))) (type: #export Alpha + {#.doc (doc "The degree of transparency of a pigment.")} Rev) (def: #export transparent + {#.doc (doc "The maximum degree of transparency.")} Alpha rev\bottom) (def: #export translucent + {#.doc (doc "The average degree of transparency.")} Alpha .5) (def: #export opaque + {#.doc (doc "The minimum degree of transparency.")} Alpha rev\top) (type: #export Pigment + {#.doc (doc "A color with some degree of transparency.")} {#color Color #alpha Alpha}) diff --git a/stdlib/source/library/lux/data/format/tar.lux b/stdlib/source/library/lux/data/format/tar.lux index d5dad8d9b..52e37991b 100644 --- a/stdlib/source/library/lux/data/format/tar.lux +++ b/stdlib/source/library/lux/data/format/tar.lux @@ -33,7 +33,8 @@ [type abstract]]]) -(type: Size Nat) +(type: Size + Nat) (def: octal_size Size 8) @@ -118,11 +119,11 @@ [pre_end <binary>.bits/8 end <binary>.bits/8 _ (let [expected (`` (char (~~ (static ..blank))))] - (<>.assert (exception.construct ..wrong_character [expected pre_end]) - (n.= expected pre_end))) + (<>.assertion (exception.construct ..wrong_character [expected pre_end]) + (n.= expected pre_end))) _ (let [expected (`` (char (~~ (static ..null))))] - (<>.assert (exception.construct ..wrong_character [expected end]) - (n.= expected end)))] + (<>.assertion (exception.construct ..wrong_character [expected end]) + (n.= expected end)))] (in []))) (def: small_parser @@ -143,8 +144,8 @@ digits (<>.lift (\ utf8.codec decode digits)) end <binary>.bits/8 _ (let [expected (`` (char (~~ (static ..blank))))] - (<>.assert (exception.construct ..wrong_character [expected end]) - (n.= expected end)))] + (<>.assertion (exception.construct ..wrong_character [expected end]) + (n.= expected end)))] (<>.lift (do {! try.monad} [value (\ n.octal decode digits)] @@ -276,8 +277,8 @@ [string (<binary>.segment <size>) end <binary>.bits/8 #let [expected (`` (char (~~ (static ..null))))] - _ (<>.assert (exception.construct ..wrong_character [expected end]) - (n.= expected end))] + _ (<>.assertion (exception.construct ..wrong_character [expected end]) + (n.= expected end))] (<>.lift (do {! try.monad} [ascii (..un_pad string) @@ -318,8 +319,8 @@ [string (<binary>.segment ..magic_size) end <binary>.bits/8 #let [expected (`` (char (~~ (static ..null))))] - _ (<>.assert (exception.construct ..wrong_character [expected end]) - (n.= expected end))] + _ (<>.assertion (exception.construct ..wrong_character [expected end]) + (n.= expected end))] (<>.lift (\ try.monad map (|>> :abstraction) (\ utf8.codec decode string))))) @@ -763,8 +764,8 @@ [actual checksum_code] ..checksum_parser _ (let [expected (expected_checksum checksum_code binary_header)] (<>.lift - (exception.assert ..wrong_checksum [expected actual] - (n.= expected actual)))) + (exception.assertion ..wrong_checksum [expected actual] + (n.= expected actual)))) link_flag ..link_flag_parser link_name ..path_parser magic ..magic_parser @@ -797,8 +798,8 @@ (-> Link_Flag (Parser File)) (do <>.monad [header ..header_parser - _ (<>.assert (exception.construct ..wrong_link_flag [expected (get@ #link_flag header)]) - (is? expected (get@ #link_flag header))) + _ (<>.assertion (exception.construct ..wrong_link_flag [expected (get@ #link_flag header)]) + (is? expected (get@ #link_flag header))) #let [size (get@ #size header) rounded_size (..rounded_content_size size)] content (<binary>.segment (..from_big size)) @@ -824,9 +825,9 @@ (do <>.monad [header ..header_parser _ (<>.lift - (exception.assert ..wrong_link_flag [expected (get@ #link_flag header)] - (n.= (..link_flag expected) - (..link_flag (get@ #link_flag header)))))] + (exception.assertion ..wrong_link_flag [expected (get@ #link_flag header)] + (n.= (..link_flag expected) + (..link_flag (get@ #link_flag header)))))] (in (extractor header)))) (def: entry_parser @@ -850,8 +851,8 @@ [block (<binary>.segment ..block_size)] (let [actual (..checksum block)] (<>.lift - (exception.assert ..wrong_checksum [0 actual] - (n.= 0 actual)))))) + (exception.assertion ..wrong_checksum [0 actual] + (n.= 0 actual)))))) (exception: #export invalid_end_of_archive) @@ -861,8 +862,8 @@ [_ (<>.at_most 2 end_of_archive_block_parser) done? <binary>.end?] (<>.lift - (exception.assert ..invalid_end_of_archive [] - done?)))) + (exception.assertion ..invalid_end_of_archive [] + done?)))) (def: #export parser (Parser Tar) diff --git a/stdlib/source/library/lux/data/format/xml.lux b/stdlib/source/library/lux/data/format/xml.lux index 468100e5b..b7cf0323d 100644 --- a/stdlib/source/library/lux/data/format/xml.lux +++ b/stdlib/source/library/lux/data/format/xml.lux @@ -31,6 +31,7 @@ (Dictionary Attribute Text)) (def: #export attributes + {#.doc (doc "An empty set of XML attributes.")} Attrs (dictionary.new name.hash)) @@ -126,10 +127,10 @@ ..spaced^ (<>.after (<text>.this "/")) (<text>.enclosed ["<" ">"]))] - (<>.assert ($_ text\compose "Close tag does not match open tag." text.new_line - "Expected: " (name\encode expected) text.new_line - " Actual: " (name\encode actual) text.new_line) - (name\= expected actual)))) + (<>.assertion ($_ text\compose "Close tag does not match open tag." text.new_line + "Expected: " (name\encode expected) text.new_line + " Actual: " (name\encode actual) text.new_line) + (name\= expected actual)))) (def: comment^ (Parser Text) @@ -210,12 +211,14 @@ (text.replace_all text.double_quote """))) (def: #export (tag [namespace name]) + {#.doc (doc "The text format of a XML tag.")} (-> Tag Text) (case namespace "" name _ ($_ text\compose namespace ..namespace_separator name))) (def: #export attribute + {#.doc (doc "The text format of a XML attribute.")} (-> Attribute Text) ..tag) diff --git a/stdlib/source/library/lux/data/identity.lux b/stdlib/source/library/lux/data/identity.lux index 521f66e3e..851504816 100644 --- a/stdlib/source/library/lux/data/identity.lux +++ b/stdlib/source/library/lux/data/identity.lux @@ -10,6 +10,7 @@ ["." function]]]]) (type: #export (Identity a) + {#.doc (doc "A value, as is, without any extra structure super-imposed on it.")} a) (implementation: #export functor diff --git a/stdlib/source/library/lux/data/lazy.lux b/stdlib/source/library/lux/data/lazy.lux index d3283cfc8..d4b345f87 100644 --- a/stdlib/source/library/lux/data/lazy.lux +++ b/stdlib/source/library/lux/data/lazy.lux @@ -20,6 +20,9 @@ (abstract: #export (Lazy a) (-> [] a) + {#.doc (doc "A value specified by an expression that is calculated only at the last moment possible." + "Afterwards, the value is cached for future reference.")} + (def: (lazy' generator) (All [a] (-> (-> [] a) (Lazy a))) (let [cache (atom.atom #.None)] @@ -33,20 +36,21 @@ (exec (io.run (atom.compare_and_swap _ (#.Some value) cache)) value))))))) - (def: #export (value l_value) + (def: #export (value lazy) (All [a] (-> (Lazy a) a)) - ((:representation l_value) []))) + ((:representation lazy) []))) -(syntax: #export (lazy expr) +(syntax: #export (lazy expression) + {#.doc (doc "Specifies a lazy value by providing the expression that computes it.")} (with_gensyms [g!_] - (in (list (` ((~! lazy') (function ((~ g!_) (~ g!_)) (~ expr)))))))) + (in (list (` ((~! lazy') (function ((~ g!_) (~ g!_)) (~ expression)))))))) -(implementation: #export (equivalence (^open "_\.")) +(implementation: #export (equivalence (^open "\.")) (All [a] (-> (Equivalence a) (Equivalence (Lazy a)))) (def: (= left right) - (_\= (..value left) - (..value right)))) + (\= (..value left) + (..value right)))) (implementation: #export functor (Functor Lazy) diff --git a/stdlib/source/library/lux/data/maybe.lux b/stdlib/source/library/lux/data/maybe.lux index b0cf1960e..7d6ac8dfa 100644 --- a/stdlib/source/library/lux/data/maybe.lux +++ b/stdlib/source/library/lux/data/maybe.lux @@ -111,6 +111,7 @@ Mma)))) (def: #export (lift monad) + {#.doc (doc "Wraps a monadic value with Maybe machinery.")} (All [M a] (-> (Monad M) (-> (M a) (M (Maybe a))))) (\ monad map (\ ..monad in))) @@ -121,6 +122,7 @@ (else +20 (#.Some +10)) "=>" +10 + -------------------------- (else +20 #.None) "=>" +20)} @@ -138,6 +140,9 @@ (#.Left "Wrong syntax for else"))) (def: #export assume + {#.doc (doc "Assumes that a Maybe value is a #.Some and yields its value." + "Raises/throws a runtime error otherwise." + "WARNING: Use with caution.")} (All [a] (-> (Maybe a) a)) (|>> (..else (undefined)))) diff --git a/stdlib/source/library/lux/data/text/encoding.lux b/stdlib/source/library/lux/data/text/encoding.lux index 3ecb5b4e0..8829d7d92 100644 --- a/stdlib/source/library/lux/data/text/encoding.lux +++ b/stdlib/source/library/lux/data/text/encoding.lux @@ -10,7 +10,9 @@ Text (template [<name> <encoding>] - [(def: #export <name> Encoding (:abstraction <encoding>))] + [(def: #export <name> + Encoding + (:abstraction <encoding>))] [ascii "ASCII"] diff --git a/stdlib/source/library/lux/data/text/encoding/utf8.lux b/stdlib/source/library/lux/data/text/encoding/utf8.lux index b24c88837..7e5c8a4e2 100644 --- a/stdlib/source/library/lux/data/text/encoding/utf8.lux +++ b/stdlib/source/library/lux/data/text/encoding/utf8.lux @@ -158,6 +158,7 @@ #try.Success)}))) (implementation: #export codec + {#.doc (doc "A codec for binary encoding of text as UTF-8.")} (Codec Binary Text) (def: encode ..encode) diff --git a/stdlib/source/library/lux/data/text/escape.lux b/stdlib/source/library/lux/data/text/escape.lux index 9ca9ecfe1..6c78dc7d5 100644 --- a/stdlib/source/library/lux/data/text/escape.lux +++ b/stdlib/source/library/lux/data/text/escape.lux @@ -110,6 +110,7 @@ post_limit])) (def: #export (escape text) + {#.doc (doc "Yields a escaped version of the text.")} (-> Text Text) (loop [offset 0 previous "" @@ -191,6 +192,8 @@ (exception.except ..invalid_unicode_escape [current offset]))) (def: #export (un_escape text) + {#.doc (doc "Yields an un-escaped text." + "Fails if it was improperly escaped.")} (-> Text (Try Text)) (loop [offset 0 previous "" @@ -236,6 +239,7 @@ _ (format previous current)))))) (syntax: #export (escaped {literal <code>.text}) + {#.doc (doc "If given a escaped text literal, expands to an un-escaped version.")} (case (..un_escape literal) (#try.Success un_escaped) (in (list (code.text un_escaped))) diff --git a/stdlib/source/library/lux/data/text/regex.lux b/stdlib/source/library/lux/data/text/regex.lux index ccbb1417a..1e2128275 100644 --- a/stdlib/source/library/lux/data/text/regex.lux +++ b/stdlib/source/library/lux/data/text/regex.lux @@ -82,7 +82,7 @@ (-> Text (Parser Code)) (do <>.monad [name (<text>.enclosed ["\@<" ">"] (name^ current_module))] - (in (` (: (Parser Text) (~ (code.identifier name))))))) + (in (` (: ((~! <text>.Parser) Text) (~ (code.identifier name))))))) (def: re_range^ (Parser Code) @@ -90,7 +90,7 @@ [from (|> regex_char^ (\ ! map (|>> (//.nth 0) maybe.assume))) _ (<text>.this "-") to (|> regex_char^ (\ ! map (|>> (//.nth 0) maybe.assume)))] - (in (` (<text>.range (~ (code.nat from)) (~ (code.nat to))))))) + (in (` ((~! <text>.range) (~ (code.nat from)) (~ (code.nat to))))))) (def: re_char^ (Parser Code) @@ -102,7 +102,7 @@ (Parser Code) (do <>.monad [options (<text>.many escaped_char^)] - (in (` (<text>.one_of (~ (code.text options))))))) + (in (` ((~! <text>.one_of) (~ (code.text options))))))) (def: re_user_class^' (Parser Code) @@ -112,8 +112,8 @@ re_range^ re_options^))] (in (case negate? - (#.Some _) (` (<text>.not ($_ <>.either (~+ parts)))) - #.None (` ($_ <>.either (~+ parts))))))) + (#.Some _) (` ((~! <text>.not) ($_ ((~! <>.either)) (~+ parts)))) + #.None (` ($_ ((~! <>.either)) (~+ parts))))))) (def: re_user_class^ (Parser Code) @@ -158,22 +158,22 @@ (do <>.monad [] ($_ <>.either - (<>.after (<text>.this ".") (in (` <text>.any))) - (<>.after (<text>.this "\d") (in (` <text>.decimal))) - (<>.after (<text>.this "\D") (in (` (<text>.not <text>.decimal)))) - (<>.after (<text>.this "\s") (in (` <text>.space))) - (<>.after (<text>.this "\S") (in (` (<text>.not <text>.space)))) + (<>.after (<text>.this ".") (in (` (~! <text>.any)))) + (<>.after (<text>.this "\d") (in (` (~! <text>.decimal)))) + (<>.after (<text>.this "\D") (in (` ((~! <text>.not) (~! <text>.decimal))))) + (<>.after (<text>.this "\s") (in (` (~! <text>.space)))) + (<>.after (<text>.this "\S") (in (` ((~! <text>.not) (~! <text>.space))))) (<>.after (<text>.this "\w") (in (` (~! word^)))) - (<>.after (<text>.this "\W") (in (` (<text>.not (~! word^))))) - - (<>.after (<text>.this "\p{Lower}") (in (` <text>.lower))) - (<>.after (<text>.this "\p{Upper}") (in (` <text>.upper))) - (<>.after (<text>.this "\p{Alpha}") (in (` <text>.alpha))) - (<>.after (<text>.this "\p{Digit}") (in (` <text>.decimal))) - (<>.after (<text>.this "\p{Alnum}") (in (` <text>.alpha_num))) - (<>.after (<text>.this "\p{Space}") (in (` <text>.space))) - (<>.after (<text>.this "\p{HexDigit}") (in (` <text>.hexadecimal))) - (<>.after (<text>.this "\p{OctDigit}") (in (` <text>.octal))) + (<>.after (<text>.this "\W") (in (` ((~! <text>.not) (~! word^))))) + + (<>.after (<text>.this "\p{Lower}") (in (` (~! <text>.lower)))) + (<>.after (<text>.this "\p{Upper}") (in (` (~! <text>.upper)))) + (<>.after (<text>.this "\p{Alpha}") (in (` (~! <text>.alpha)))) + (<>.after (<text>.this "\p{Digit}") (in (` (~! <text>.decimal)))) + (<>.after (<text>.this "\p{Alnum}") (in (` (~! <text>.alpha_num)))) + (<>.after (<text>.this "\p{Space}") (in (` (~! <text>.space)))) + (<>.after (<text>.this "\p{HexDigit}") (in (` (~! <text>.hexadecimal)))) + (<>.after (<text>.this "\p{OctDigit}") (in (` (~! <text>.octal)))) (<>.after (<text>.this "\p{Blank}") (in (` (~! blank^)))) (<>.after (<text>.this "\p{ASCII}") (in (` (~! ascii^)))) (<>.after (<text>.this "\p{Contrl}") (in (` (~! control^)))) @@ -220,14 +220,14 @@ quantifier (<text>.one_of "?*+")] (case quantifier "?" - (in (` (<>.else "" (~ base)))) + (in (` ((~! <>.else) "" (~ base)))) "*" - (in (` ((~! join_text^) (<>.some (~ base))))) + (in (` ((~! join_text^) ((~! <>.some) (~ base))))) ## "+" _ - (in (` ((~! join_text^) (<>.many (~ base))))) + (in (` ((~! join_text^) ((~! <>.many) (~ base))))) ))) (exception: #export (incorrect_quantification {from Nat} {to Nat}) @@ -243,20 +243,21 @@ ($_ <>.either (do ! [[from to] (<>.and number^ (<>.after (<text>.this ",") number^)) - _ (<>.assert (exception.construct ..incorrect_quantification [from to]) - (n.<= to from))] - (in (` ((~! join_text^) (<>.between (~ (code.nat from)) - (~ (code.nat (n.- from to))) - (~ base)))))) + _ (<>.assertion (exception.construct ..incorrect_quantification [from to]) + (n.<= to from))] + (in (` ((~! join_text^) ((~! <>.between) + (~ (code.nat from)) + (~ (code.nat (n.- from to))) + (~ base)))))) (do ! [limit (<>.after (<text>.this ",") number^)] - (in (` ((~! join_text^) (<>.at_most (~ (code.nat limit)) (~ base)))))) + (in (` ((~! join_text^) ((~! <>.at_most) (~ (code.nat limit)) (~ base)))))) (do ! [limit (<>.before (<text>.this ",") number^)] - (in (` ((~! join_text^) (<>.at_least (~ (code.nat limit)) (~ base)))))) + (in (` ((~! join_text^) ((~! <>.at_least) (~ (code.nat limit)) (~ base)))))) (do ! [limit number^] - (in (` ((~! join_text^) (<>.exactly (~ (code.nat limit)) (~ base)))))))))) + (in (` ((~! join_text^) ((~! <>.exactly) (~ (code.nat limit)) (~ base)))))))))) (def: (re_quantified^ current_module) (-> Text (Parser Code)) @@ -318,10 +319,10 @@ (in [(if capturing? (list.size names) 0) - (` (do <>.monad - [(~ (' #let)) [(~ g!total) ""] - (~+ (|> steps list.reverse list\join))] - ((~ (' in)) [(~ g!total) (~+ (list.reverse names))])))]) + (` ((~! do) (~! <>.monad) + [(~ (' #let)) [(~ g!total) ""] + (~+ (|> steps list.reverse list\join))] + ((~ (' in)) [(~ g!total) (~+ (list.reverse names))])))]) )) (def: (unflatten^ lexer) diff --git a/stdlib/source/library/lux/data/text/unicode/block.lux b/stdlib/source/library/lux/data/text/unicode/block.lux index e67eb3ae3..5c4d9ec76 100644 --- a/stdlib/source/library/lux/data/text/unicode/block.lux +++ b/stdlib/source/library/lux/data/text/unicode/block.lux @@ -6,6 +6,15 @@ [hash (#+ Hash)] [monoid (#+ Monoid)] ["." interval (#+ Interval)]] + [control + [parser + ["<.>" code]]] + [data + ["." text]] + [macro + [syntax (#+ syntax:)] + ["." template] + ["." code]] [math [number (#+ hex) ["n" nat ("#\." interval)] @@ -16,6 +25,8 @@ (abstract: #export Block (Interval Char) + + {#.doc (doc "A block of valid unicode characters.")} (implementation: #export monoid (Monoid Block) @@ -32,9 +43,9 @@ (n.max (\ left top) (\ right top))))))) - (def: #export (block start end) - (-> Char Char Block) - (:abstraction (interval.between n.enum (n.min start end) (n.max start end)))) + (def: #export (block start additional) + (-> Char Nat Block) + (:abstraction (interval.between n.enum start (n.+ additional start)))) (template [<name> <slot>] [(def: #export <name> @@ -71,8 +82,18 @@ (i64.or (i64.left_shifted 32 (..start value)) (..end value)))) +(syntax: (block_name {name <code>.local_identifier}) + (in (list (code.text (text.replace_all "_" " " name))))) + (template [<name> <start> <end>] - [(def: #export <name> Block (..block (hex <start>) (hex <end>)))] + [(with_expansions [<block_name> (..block_name <name>) + <documentation> (template.text [<start> "-" <end> " | " <block_name>])] + (def: #export <name> + {#.doc (doc <documentation>)} + Block + (let [start (hex <start>) + end (hex <end>)] + (..block start (n.- start end)))))] ## Normal blocks [basic_latin "0000" "007F"] diff --git a/stdlib/source/library/lux/data/text/unicode/set.lux b/stdlib/source/library/lux/data/text/unicode/set.lux index 1f2d411f9..0a5aa6ce8 100644 --- a/stdlib/source/library/lux/data/text/unicode/set.lux +++ b/stdlib/source/library/lux/data/text/unicode/set.lux @@ -200,11 +200,17 @@ ..non_character )) - (def: #export (range set) - (-> Set [Char Char]) - (let [tag (tree.tag (:representation set))] - [(//block.start tag) - (//block.end tag)])) + (def: #export start + (-> Set Char) + (|>> :representation + tree.tag + //block.start)) + + (def: #export end + (-> Set Char) + (|>> :representation + tree.tag + //block.end)) (def: #export (member? set character) (-> Set Char Bit) @@ -229,6 +235,7 @@ (template [<name> <blocks>] [(def: #export <name> + Set (..set <blocks>))] [ascii [//block.basic_latin (list)]] diff --git a/stdlib/source/library/lux/ffi.jvm.lux b/stdlib/source/library/lux/ffi.jvm.lux index c5080d912..1067f8357 100644 --- a/stdlib/source/library/lux/ffi.jvm.lux +++ b/stdlib/source/library/lux/ffi.jvm.lux @@ -547,21 +547,21 @@ ["Name" (%.text name)] ["Type Variables" (exception.enumerate parser.name type_vars)])) -(def: (assert exception payload test) +(def: (assertion exception payload test) (All [e] (-> (Exception e) e Bit (Parser Any))) - (<>.assert (exception.construct exception payload) - test)) + (<>.assertion (exception.construct exception payload) + test)) (def: (valid_class_name type_vars) (-> (List (Type Var)) (Parser External)) (do <>.monad [name <code>.local_identifier - _ (..assert ..class_names_cannot_contain_periods [name] - (not (text.contains? name.external_separator name))) - _ (..assert ..class_name_cannot_be_a_type_variable [name type_vars] - (not (list.member? text.equivalence - (list\map parser.name type_vars) - name)))] + _ (..assertion ..class_names_cannot_contain_periods [name] + (not (text.contains? name.external_separator name))) + _ (..assertion ..class_name_cannot_be_a_type_variable [name type_vars] + (not (list.member? text.equivalence + (list\map parser.name type_vars) + name)))] (in name))) (def: (class^' parameter^ type_vars) @@ -586,8 +586,8 @@ (-> (List (Type Var)) (Parser (Type Parameter))) (do <>.monad [name <code>.local_identifier - _ (..assert ..unexpected_type_variable [name type_vars] - (list.member? text.equivalence (list\map parser.name type_vars) name))] + _ (..assertion ..unexpected_type_variable [name type_vars] + (list.member? text.equivalence (list\map parser.name type_vars) name))] (in (type.var name)))) (def: wildcard^ diff --git a/stdlib/source/library/lux/ffi.old.lux b/stdlib/source/library/lux/ffi.old.lux index 119c1d091..89feff739 100644 --- a/stdlib/source/library/lux/ffi.old.lux +++ b/stdlib/source/library/lux/ffi.old.lux @@ -523,10 +523,10 @@ (<>.or (<code>.this! (' <)) (<code>.this! (' >)))) -(def: (assert_no_periods name) +(def: (no_periods_assertion name) (-> Text (Parser Any)) - (<>.assert "Names in class declarations cannot contain periods." - (not (text.contains? "." name)))) + (<>.assertion "Names in class declarations cannot contain periods." + (not (text.contains? "." name)))) (def: (generic_type^ type_vars) (-> (List Type_Parameter) (Parser GenericType)) @@ -543,7 +543,7 @@ (in (#GenericWildcard (#.Some [bound_kind bound]))))) (do <>.monad [name <code>.local_identifier - _ (assert_no_periods name)] + _ (no_periods_assertion name)] (if (list.member? text.equivalence (list\map product.left type_vars) name) (in (#GenericTypeVar name)) (in (#GenericClass name (list))))) @@ -566,10 +566,10 @@ (in (#GenericArray component))))) (<code>.form (do <>.monad [name <code>.local_identifier - _ (assert_no_periods name) + _ (no_periods_assertion name) params (<>.some recur^) - _ (<>.assert (format name " cannot be a type-parameter!") - (not (list.member? text.equivalence (list\map product.left type_vars) name)))] + _ (<>.assertion (format name " cannot be a type-parameter!") + (not (list.member? text.equivalence (list\map product.left type_vars) name)))] (in (#GenericClass name params)))) )))) @@ -595,11 +595,11 @@ (Parser Class_Declaration) (<>.either (do <>.monad [name <code>.local_identifier - _ (assert_no_periods name)] + _ (no_periods_assertion name)] (in [name (list)])) (<code>.form (do <>.monad [name <code>.local_identifier - _ (assert_no_periods name) + _ (no_periods_assertion name) params (<>.some ..type_param^)] (in [name params]))) )) @@ -608,11 +608,11 @@ (-> (List Type_Parameter) (Parser Super_Class_Decl)) (<>.either (do <>.monad [name <code>.local_identifier - _ (assert_no_periods name)] + _ (no_periods_assertion name)] (in [name (list)])) (<code>.form (do <>.monad [name <code>.local_identifier - _ (assert_no_periods name) + _ (no_periods_assertion name) params (<>.some (..generic_type^ type_vars))] (in [name params]))))) diff --git a/stdlib/source/library/lux/math/modular.lux b/stdlib/source/library/lux/math/modular.lux index 0657f48b5..a6ab5afc1 100644 --- a/stdlib/source/library/lux/math/modular.lux +++ b/stdlib/source/library/lux/math/modular.lux @@ -75,8 +75,8 @@ (<text>.run (do <>.monad [[value _ actual] ($_ <>.and intL (<text>.this ..separator) intL) - _ (<>.assert (exception.construct ..incorrect_modulus [expected actual]) - (i.= (//.divisor expected) actual))] + _ (<>.assertion (exception.construct ..incorrect_modulus [expected actual]) + (i.= (//.divisor expected) actual))] (in (..modular expected value)))))) (template [<name> <op>] diff --git a/stdlib/source/library/lux/math/number/complex.lux b/stdlib/source/library/lux/math/number/complex.lux index 1a34bfbf5..e927bc791 100644 --- a/stdlib/source/library/lux/math/number/complex.lux +++ b/stdlib/source/library/lux/math/number/complex.lux @@ -81,13 +81,13 @@ (|>> (update@ #real <transform>) (update@ #imaginary <transform>)))] - [negate f.negate] + [opposite f.opposite] [signum f.signum] ) (def: #export conjugate (-> Complex Complex) - (update@ #imaginary f.negate)) + (update@ #imaginary f.opposite)) (def: #export (*' param input) (-> Frac Complex Complex) @@ -141,8 +141,8 @@ (let [(^slots [#real #imaginary]) subject] {#real (f.* (math.cosh imaginary) (math.cos real)) - #imaginary (f.negate (f.* (math.sinh imaginary) - (math.sin real)))})) + #imaginary (f.opposite (f.* (math.sinh imaginary) + (math.sin real)))})) (def: #export (cosh subject) (-> Complex Complex) @@ -252,19 +252,19 @@ scale (f./ (|> real (f.* q) (f.+ imaginary)) +1.0)] {#real (f.* q scale) - #imaginary (f.negate scale)}) + #imaginary (f.opposite scale)}) (let [q (f./ real imaginary) scale (f./ (|> imaginary (f.* q) (f.+ real)) +1.0)] {#real scale - #imaginary (|> scale f.negate (f.* q))}))) + #imaginary (|> scale f.opposite (f.* q))}))) (def: #export (acos input) (-> Complex Complex) (|> input (..+ (|> input ..root/2-1z (..* ..i))) ..log - (..* (..negate ..i)))) + (..* (..opposite ..i)))) (def: #export (asin input) (-> Complex Complex) @@ -272,7 +272,7 @@ ..root/2-1z (..+ (..* ..i input)) ..log - (..* (..negate ..i)))) + (..* (..opposite ..i)))) (def: #export (atan input) (-> Complex Complex) diff --git a/stdlib/source/library/lux/math/number/frac.lux b/stdlib/source/library/lux/math/number/frac.lux index 5576109a7..d2ed4651a 100644 --- a/stdlib/source/library/lux/math/number/frac.lux +++ b/stdlib/source/library/lux/math/number/frac.lux @@ -77,7 +77,7 @@ [(../ param subject) (..% param subject)]) -(def: #export negate +(def: #export opposite (-> Frac Frac) (..* -1.0)) diff --git a/stdlib/source/library/lux/math/number/int.lux b/stdlib/source/library/lux/math/number/int.lux index 9724bc766..64984968e 100644 --- a/stdlib/source/library/lux/math/number/int.lux +++ b/stdlib/source/library/lux/math/number/int.lux @@ -88,7 +88,7 @@ [(../ param subject) (..% param subject)]) -(def: #export (negate value) +(def: #export (opposite value) (-> Int Int) (..- value +0)) @@ -218,7 +218,7 @@ (def: (encode value) (if (..< +0 value) - (|> value inc ..negate .nat inc (\ <codec> encode) ("lux text concat" ..-sign)) + (|> value inc ..opposite .nat inc (\ <codec> encode) ("lux text concat" ..-sign)) (|> value .nat (\ <codec> encode) ("lux text concat" ..+sign)))) (def: (decode repr) @@ -235,7 +235,7 @@ (|> repr ("lux text clip" 1 (dec input_size)) (\ <codec> decode) - (\ try.functor map (|>> dec .int ..negate dec))) + (\ try.functor map (|>> dec .int ..opposite dec))) _ (#try.Failure <error>)) diff --git a/stdlib/source/library/lux/math/number/rev.lux b/stdlib/source/library/lux/math/number/rev.lux index 72073f421..d0c4ac406 100644 --- a/stdlib/source/library/lux/math/number/rev.lux +++ b/stdlib/source/library/lux/math/number/rev.lux @@ -227,7 +227,7 @@ [minimum ..min top] ) -(def: (de_prefix input) +(def: (decimals input) (-> Text Text) ("lux text clip" 1 (dec ("lux text size" input)) input)) @@ -259,7 +259,7 @@ (if (//nat.> 1 repr_size) (case ("lux text char" 0 repr) (^ (char ".")) - (case (\ <codec> decode (de_prefix repr)) + (case (\ <codec> decode (..decimals repr)) (#try.Success output) (#try.Success (.rev output)) @@ -285,55 +285,54 @@ ## write the encoding/decoding algorithm once, in pure Lux, rather ## than having to implement it on the compiler for every platform ## targeted by Lux. -(type: Digits (Array Nat)) +(type: Digits + (Array Nat)) -(def: (digits::new _) +(def: (digits _) (-> Any Digits) (array.new //i64.width)) -(def: (digits::get idx digits) +(def: (digit idx digits) (-> Nat Digits Nat) - (|> digits (array.read idx) (maybe.else 0))) + (|> digits + (array.read idx) + (maybe.else 0))) -(def: digits::put +(def: digits\put! (-> Nat Nat Digits Digits) array.write!) -(def: (prepend left right) - (-> Text Text Text) - ("lux text concat" left right)) - -(def: (digits::times_5! idx output) +(def: (digits\times_5! idx output) (-> Nat Digits Digits) (loop [idx idx carry 0 output output] (if (//int.>= +0 (.int idx)) - (let [raw (|> (digits::get idx output) + (let [raw (|> (..digit idx output) (//nat.* 5) (//nat.+ carry))] (recur (dec idx) (//nat./ 10 raw) - (digits::put idx (//nat.% 10 raw) output))) + (digits\put! idx (//nat.% 10 raw) output))) output))) -(def: (digits::power power) +(def: (power_digits power) (-> Nat Digits) (loop [times power - output (|> (digits::new []) - (digits::put power 1))] + output (|> (..digits []) + (digits\put! power 1))] (if (//int.>= +0 (.int times)) (recur (dec times) - (digits::times_5! power output)) + (digits\times_5! power output)) output))) -(def: (digits::format digits) +(def: (format digits) (-> Digits Text) (loop [idx (dec //i64.width) all_zeroes? true output ""] (if (//int.>= +0 (.int idx)) - (let [digit (digits::get idx digits)] + (let [digit (..digit idx digits)] (if (and (//nat.= 0 digit) all_zeroes?) (recur (dec idx) true output) @@ -346,27 +345,27 @@ "0" output)))) -(def: (digits::+ param subject) +(def: (digits\+! param subject) (-> Digits Digits Digits) (loop [idx (dec //i64.width) carry 0 - output (digits::new [])] + output (..digits [])] (if (//int.>= +0 (.int idx)) (let [raw ($_ //nat.+ carry - (digits::get idx param) - (digits::get idx subject))] + (..digit idx param) + (..digit idx subject))] (recur (dec idx) (//nat./ 10 raw) - (digits::put idx (//nat.% 10 raw) output))) + (digits\put! idx (//nat.% 10 raw) output))) output))) -(def: (text_to_digits input) +(def: (text_digits input) (-> Text (Maybe Digits)) (let [length ("lux text size" input)] (if (//nat.<= //i64.width length) (loop [idx 0 - output (digits::new [])] + output (..digits [])] (if (//nat.< length idx) (case ("lux text index" 0 ("lux text clip" idx 1 input) "0123456789") #.None @@ -374,39 +373,39 @@ (#.Some digit) (recur (inc idx) - (digits::put idx digit output))) + (digits\put! idx digit output))) (#.Some output))) #.None))) -(def: (digits::< param subject) +(def: (digits\< param subject) (-> Digits Digits Bit) (loop [idx 0] (and (//nat.< //i64.width idx) - (let [pd (digits::get idx param) - sd (digits::get idx subject)] + (let [pd (..digit idx param) + sd (..digit idx subject)] (if (//nat.= pd sd) (recur (inc idx)) (//nat.< pd sd)))))) -(def: (digits::-!' idx param subject) +(def: (digits\-!' idx param subject) (-> Nat Nat Digits Digits) - (let [sd (digits::get idx subject)] + (let [sd (..digit idx subject)] (if (//nat.>= param sd) - (digits::put idx (//nat.- param sd) subject) + (digits\put! idx (//nat.- param sd) subject) (let [diff (|> sd (//nat.+ 10) (//nat.- param))] (|> subject - (digits::put idx diff) - (digits::-!' (dec idx) 1)))))) + (digits\put! idx diff) + (digits\-!' (dec idx) 1)))))) -(def: (digits::-! param subject) +(def: (digits\-! param subject) (-> Digits Digits Digits) (loop [idx (dec //i64.width) output subject] (if (//int.>= +0 (.int idx)) (recur (dec idx) - (digits::-!' idx (digits::get idx param) output)) + (digits\-!' idx (..digit idx param) output)) output))) (implementation: #export decimal @@ -420,16 +419,16 @@ input (let [last_idx (dec //i64.width)] (loop [idx last_idx - digits (digits::new [])] + digits (..digits [])] (if (//int.>= +0 (.int idx)) (if (//i64.set? idx input) - (let [digits' (digits::+ (digits::power (//nat.- idx last_idx)) + (let [digits' (digits\+! (power_digits (//nat.- idx last_idx)) digits)] (recur (dec idx) digits')) (recur (dec idx) digits)) - ("lux text concat" "." (digits::format digits)) + ("lux text concat" "." (..format digits)) ))))) (def: (decode input) @@ -442,17 +441,17 @@ within_limits? (//nat.<= (inc //i64.width) ("lux text size" input))] (if (and dotted? within_limits?) - (case (text_to_digits (de_prefix input)) + (case (|> input ..decimals ..text_digits) (#.Some digits) (loop [digits digits idx 0 output 0] (if (//nat.< //i64.width idx) - (let [power (digits::power idx)] - (if (digits::< power digits) + (let [power (power_digits idx)] + (if (digits\< power digits) ## Skip power (recur digits (inc idx) output) - (recur (digits::-! power digits) + (recur (digits\-! power digits) (inc idx) (//i64.set (//nat.- idx (dec //i64.width)) output)))) (#try.Success (.rev output)))) diff --git a/stdlib/source/library/lux/math/random.lux b/stdlib/source/library/lux/math/random.lux index c4f307a7b..74857ba27 100644 --- a/stdlib/source/library/lux/math/random.lux +++ b/stdlib/source/library/lux/math/random.lux @@ -153,7 +153,8 @@ (def: #export (char set) (-> unicode.Set (Random Char)) - (let [[start end] (unicode.range set) + (let [start (unicode.start set) + end (unicode.end set) size (n.- start end) in_range (: (-> Char Char) (|>> (n.% size) (n.+ start)))] diff --git a/stdlib/source/library/lux/meta.lux b/stdlib/source/library/lux/meta.lux index 5c7d102fe..924401e04 100644 --- a/stdlib/source/library/lux/meta.lux +++ b/stdlib/source/library/lux/meta.lux @@ -102,7 +102,7 @@ (#try.Success [compiler' output]) (#try.Success [compiler' output])))) -(def: #export (assert message test) +(def: #export (assertion message test) {#.doc "Fails with the given message if the test is #0."} (-> Text Bit (Meta Any)) (function (_ compiler) diff --git a/stdlib/source/library/lux/target/js.lux b/stdlib/source/library/lux/target/js.lux index 8bbb1dd93..f1eea8098 100644 --- a/stdlib/source/library/lux/target/js.lux +++ b/stdlib/source/library/lux/target/js.lux @@ -23,7 +23,7 @@ (def: element (text.enclosed ["[" "]"])) -(def: nest +(def: nested (-> Text Text) (|>> (format text.new_line) (text.replace_all text.new_line (format text.new_line text.tab)))) @@ -172,7 +172,7 @@ (-> Statement Text) (let [close (format text.new_line "}")] (|>> :representation - ..nest + ..nested (text.enclosed ["{" close])))) @@ -245,7 +245,7 @@ [not "!"] [bit_not "~"] - [negate "-"] + [opposite "-"] ) (template [<name> <input> <format>] @@ -410,13 +410,13 @@ (format (|> when (list\map (|>> :representation (text.enclosed ["case " ":"]))) (text.join_with text.new_line)) - (..nest (:representation then))))) + (..nested (:representation then))))) (text.join_with text.new_line)) text.new_line (case default (#.Some default) (format "default:" - (..nest (:representation default))) + (..nested (:representation default))) #.None "")) :abstraction diff --git a/stdlib/source/library/lux/target/jvm/bytecode.lux b/stdlib/source/library/lux/target/jvm/bytecode.lux index 8ca668f99..33df05fbb 100644 --- a/stdlib/source/library/lux/target/jvm/bytecode.lux +++ b/stdlib/source/library/lux/target/jvm/bytecode.lux @@ -748,8 +748,8 @@ [(function (_ resolver) (do try.monad [[expected @to] (..resolve_label label resolver) - _ (exception.assert ..mismatched_environments [(name_of <instruction>) label @here expected actual] - (\ /stack.equivalence = expected actual)) + _ (exception.assertion ..mismatched_environments [(name_of <instruction>) label @here expected actual] + (\ /stack.equivalence = expected actual)) jump (..jump @from @to)] (case jump (#.Left jump) @@ -799,8 +799,8 @@ (case (dictionary.get label resolver) (#.Some [expected (#.Some @to)]) (do try.monad - [_ (exception.assert ..mismatched_environments [(name_of <instruction>) label @here expected actual] - (\ /stack.equivalence = expected actual)) + [_ (exception.assertion ..mismatched_environments [(name_of <instruction>) label @here expected actual] + (\ /stack.equivalence = expected actual)) jump (..jump @from @to)] (case jump (#.Left jump) diff --git a/stdlib/source/library/lux/target/lua.lux b/stdlib/source/library/lux/target/lua.lux index 05a2847e7..ee245e6f6 100644 --- a/stdlib/source/library/lux/target/lua.lux +++ b/stdlib/source/library/lux/target/lua.lux @@ -27,7 +27,7 @@ [type abstract]]]) -(def: nest +(def: nested (-> Text Text) (.let [nested_new_line (format text.new_line text.tab)] (|>> (format text.new_line) @@ -228,7 +228,7 @@ (:abstraction (format "(" <unary> " " (:representation subject) ")")))] [not "not"] - [negate "-"] + [opposite "-"] ) (template [<name> <type>] @@ -275,28 +275,28 @@ (def: #export (if test then! else!) (-> Expression Statement Statement Statement) (:abstraction (format "if " (:representation test) - text.new_line "then" (..nest (:representation then!)) - text.new_line "else" (..nest (:representation else!)) + text.new_line "then" (..nested (:representation then!)) + text.new_line "else" (..nested (:representation else!)) text.new_line "end"))) (def: #export (when test then!) (-> Expression Statement Statement) (:abstraction (format "if " (:representation test) - text.new_line "then" (..nest (:representation then!)) + text.new_line "then" (..nested (:representation then!)) text.new_line "end"))) (def: #export (while test body!) (-> Expression Statement Statement) (:abstraction (format "while " (:representation test) " do" - (..nest (:representation body!)) + (..nested (:representation body!)) text.new_line "end"))) (def: #export (repeat until body!) (-> Expression Statement Statement) (:abstraction (format "repeat" - (..nest (:representation body!)) + (..nested (:representation body!)) text.new_line "until " (:representation until)))) (def: #export (for_in vars source body!) @@ -306,7 +306,7 @@ (list\map ..code) (text.join_with ..input_separator)) " in " (:representation source) " do" - (..nest (:representation body!)) + (..nested (:representation body!)) text.new_line "end"))) (def: #export (for_step var from to step body!) @@ -317,7 +317,7 @@ " = " (:representation from) ..input_separator (:representation to) ..input_separator (:representation step) " do" - (..nest (:representation body!)) + (..nested (:representation body!)) text.new_line "end"))) (def: #export (return value) @@ -329,7 +329,7 @@ (|> (format "function " (|> args ..locations (text.enclosed ["(" ")"])) - (..nest (:representation body!)) + (..nested (:representation body!)) text.new_line "end") (text.enclosed ["(" ")"]) :abstraction)) @@ -342,7 +342,7 @@ (|> args ..locations (text.enclosed ["(" ")"])) - (..nest (:representation body!)) + (..nested (:representation body!)) text.new_line "end")))] [function "function"] diff --git a/stdlib/source/library/lux/target/php.lux b/stdlib/source/library/lux/target/php.lux index e96d8fe85..45bf1f33e 100644 --- a/stdlib/source/library/lux/target/php.lux +++ b/stdlib/source/library/lux/target/php.lux @@ -29,7 +29,7 @@ (def: input_separator ", ") (def: statement_suffix ";") -(def: nest +(def: nested (-> Text Text) (.let [nested_new_line (format text.new_line text.tab)] (|>> (format text.new_line) @@ -37,7 +37,7 @@ (def: block (-> Text Text) - (|>> ..nest (text.enclosed ["{" (format text.new_line "}")]))) + (|>> ..nested (text.enclosed ["{" (format text.new_line "}")]))) (def: group (-> Text Text) @@ -395,7 +395,7 @@ ["!" not] ["~" bit_not] - ["-" negate] + ["-" opposite] ) (def: #export (set var value) diff --git a/stdlib/source/library/lux/target/python.lux b/stdlib/source/library/lux/target/python.lux index b7ac6a094..cf4917ac5 100644 --- a/stdlib/source/library/lux/target/python.lux +++ b/stdlib/source/library/lux/target/python.lux @@ -37,7 +37,7 @@ (replace [java/lang/CharSequence java/lang/CharSequence] java/lang/String)]))} (as_is)) -(def: nest +(def: nested (-> Text Text) (.let [nested_new_line (format text.new_line text.tab)] (for {@.old (|>> (format text.new_line) @@ -314,7 +314,7 @@ (format <unary> " " (:representation subject))))] [not "not"] - [negate "-"] + [opposite "-"] ) (def: #export (lambda arguments body) @@ -339,15 +339,15 @@ (-> (Expression Any) (Statement Any) (Statement Any) (Statement Any)) (:abstraction (format "if " (:representation test) ":" - (..nest (:representation then!)) + (..nested (:representation then!)) text.new_line "else:" - (..nest (:representation else!))))) + (..nested (:representation else!))))) (def: #export (when test then!) (-> (Expression Any) (Statement Any) (Statement Any)) (:abstraction (format "if " (:representation test) ":" - (..nest (:representation then!))))) + (..nested (:representation then!))))) (def: #export (then pre! post!) (-> (Statement Any) (Statement Any) (Statement Any)) @@ -369,11 +369,11 @@ (-> (Expression Any) (Statement Any) (Maybe (Statement Any)) Loop) (:abstraction (format "while " (:representation test) ":" - (..nest (:representation body!)) + (..nested (:representation body!)) (case else! (#.Some else!) (format text.new_line "else:" - (..nest (:representation else!))) + (..nested (:representation else!))) #.None "")))) @@ -382,7 +382,7 @@ (-> SVar (Expression Any) (Statement Any) Loop) (:abstraction (format "for " (:representation var) " in " (:representation inputs) ":" - (..nest (:representation body!))))) + (..nested (:representation body!))))) (def: #export statement (-> (Expression Any) (Statement Any)) @@ -401,12 +401,12 @@ (-> (Statement Any) (List Except) (Statement Any)) (:abstraction (format "try:" - (..nest (:representation body!)) + (..nested (:representation body!)) (|> excepts (list\map (function (_ [classes exception catch!]) (format text.new_line "except (" (text.join_with ", " (list\map ..code classes)) ") as " (:representation exception) ":" - (..nest (:representation catch!))))) + (..nested (:representation catch!))))) (text.join_with ""))))) (template [<name> <keyword> <pre>] @@ -436,7 +436,7 @@ (:abstraction (format "def " (:representation name) "(" (|> args (list\map ..code) (text.join_with ", ")) "):" - (..nest (:representation body))))) + (..nested (:representation body))))) (def: #export (import module_name) (-> Text (Statement Any)) diff --git a/stdlib/source/library/lux/target/r.lux b/stdlib/source/library/lux/target/r.lux index 01deac3a2..9028c03f5 100644 --- a/stdlib/source/library/lux/target/r.lux +++ b/stdlib/source/library/lux/target/r.lux @@ -75,20 +75,20 @@ (def: nested_new_line (format text.new_line text.tab)) - (def: nest + (def: nested (-> Text Text) (|>> (text.replace_all text.new_line ..nested_new_line) (format ..nested_new_line))) (def: (_block expression) (-> Text Text) - (format "{" (nest expression) text.new_line "}")) + (format "{" (nested expression) text.new_line "}")) (def: #export (block expression) (-> Expression Expression) (:abstraction (format "{" - (..nest (:representation expression)) + (..nested (:representation expression)) text.new_line "}"))) (template [<name> <r>] @@ -174,7 +174,7 @@ (|> args (list\map ..code) (text.join_with (format "," text.new_line)) - ..nest) + ..nested) ")")))) (template [<name> <function>] diff --git a/stdlib/source/library/lux/target/ruby.lux b/stdlib/source/library/lux/target/ruby.lux index 7f6b66c74..9af88a4fc 100644 --- a/stdlib/source/library/lux/target/ruby.lux +++ b/stdlib/source/library/lux/target/ruby.lux @@ -29,7 +29,7 @@ (def: input_separator ", ") (def: statement_suffix ";") -(def: nest +(def: nested (-> Text Text) (.let [nested_new_line (format text.new_line text.tab)] (|>> (format text.new_line) @@ -279,9 +279,9 @@ (<| :abstraction ..block (format "if " (:representation test) - (..nest (:representation then!)) + (..nested (:representation then!)) text.new_line "else" - (..nest (:representation else!))))) + (..nested (:representation else!))))) (template [<name> <block>] [(def: #export (<name> test then!) @@ -289,7 +289,7 @@ (<| :abstraction ..block (format <block> " " (:representation test) - (..nest (:representation then!)))))] + (..nested (:representation then!)))))] [when "if"] [while "while"] @@ -302,7 +302,7 @@ (format "for " (:representation var) " in " (:representation array) " do " - (..nest (:representation iteration!))))) + (..nested (:representation iteration!))))) (type: #export Rescue {#classes (List Text) @@ -313,12 +313,12 @@ (-> Statement (List Rescue) Statement) (<| :abstraction ..block - (format "begin" (..nest (:representation body!)) + (format "begin" (..nested (:representation body!)) (|> rescues (list\map (.function (_ [classes exception rescue]) (format text.new_line "rescue " (text.join_with ..input_separator classes) " => " (:representation exception) - (..nest (:representation rescue))))) + (..nested (:representation rescue))))) (text.join_with text.new_line))))) (def: #export (catch expectation body!) @@ -326,7 +326,7 @@ (<| :abstraction ..block (format "catch(" (:representation expectation) ") do" - (..nest (:representation body!))))) + (..nested (:representation body!))))) (def: #export (return value) (-> Expression Statement) @@ -357,7 +357,7 @@ (list\map (|>> :representation)) (text.join_with ..input_separator) (text.enclosed ["(" ")"])) - (..nest (:representation body!))))) + (..nested (:representation body!))))) (def: #export (lambda name args body!) (-> (Maybe LVar) (List Var) Statement Literal) @@ -365,7 +365,7 @@ (list\map (|>> :representation)) (text.join_with ..input_separator) (text.enclosed' "|")) - (..nest (:representation body!))) + (..nested (:representation body!))) (text.enclosed ["{" "}"]) (format "lambda "))] (|> (case name @@ -411,7 +411,7 @@ (:abstraction (format "(" <unary> (:representation subject) ")")))] ["!" not] - ["-" negate] + ["-" opposite] ) (def: #export (comment commentary on) diff --git a/stdlib/source/library/lux/target/scheme.lux b/stdlib/source/library/lux/target/scheme.lux index f2b855522..fc60d76f7 100644 --- a/stdlib/source/library/lux/target/scheme.lux +++ b/stdlib/source/library/lux/target/scheme.lux @@ -21,7 +21,7 @@ [type abstract]]]) -(def: nest +(def: nested (-> Text Text) (.let [nested_new_line (format text.new_line text.tab)] (text.replace_all text.new_line nested_new_line))) @@ -160,7 +160,7 @@ (#.Item head tail) (|> tail - (list\map (|>> :representation nest)) + (list\map (|>> :representation ..nested)) (#.Item (:representation head)) (text.join_with nested_new_line) (text.enclosed ["(" ")"]) diff --git a/stdlib/source/library/lux/test.lux b/stdlib/source/library/lux/test.lux index ee3604c0a..00ab760d3 100644 --- a/stdlib/source/library/lux/test.lux +++ b/stdlib/source/library/lux/test.lux @@ -125,7 +125,7 @@ async\in random\in)) -(def: #export (assert message condition) +(def: #export (assertion message condition) {#.doc "Check that a condition is #1, and fail with the given message otherwise."} (-> Text Bit Assertion) (<| async\in @@ -136,11 +136,11 @@ (def: #export (test message condition) {#.doc "Check that a condition is #1, and fail with the given message otherwise."} (-> Text Bit Test) - (random\in (..assert message condition))) + (random\in (..assertion message condition))) (def: #export (lift message random) (-> Text (Random Bit) Test) - (random\map (..assert message) random)) + (random\map (..assertion message) random)) (def: pcg32_magic_inc Nat @@ -263,7 +263,7 @@ (list\map %.name) (text.join_with " & ")) coverage (set.of_list name.hash coverage)] - (|> (..assert message condition) + (|> (..assertion message condition) (async\map (function (_ [tally documentation]) [(update@ #actual_coverage (set.union coverage) tally) documentation]))))) @@ -390,7 +390,7 @@ output (#try.Failure error) - (..assert (exception.construct ..error_during_execution [error]) false)) + (..assertion (exception.construct ..error_during_execution [error]) false)) io.io async.future async\join)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux b/stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux index 8588f52e0..f188f3c7d 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux @@ -473,7 +473,7 @@ (All [e] (-> (Exception e) e Operation)) (..failure (exception.construct exception parameters))) -(def: #export (assert exception parameters condition) +(def: #export (assertion exception parameters condition) (All [e] (-> (Exception e) e Bit (Operation Any))) (if condition (\ phase.monad in []) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case.lux index 291cf89c2..b99a93f73 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case.lux @@ -314,8 +314,8 @@ outputTC (monad.map ! (|>> product.left /coverage.determine) outputT) _ (.case (monad.fold try.monad /coverage.merge outputHC outputTC) (#try.Success coverage) - (///.assert non_exhaustive_pattern_matching [inputC branches coverage] - (/coverage.exhaustive? coverage)) + (///.assertion non_exhaustive_pattern_matching [inputC branches coverage] + (/coverage.exhaustive? coverage)) (#try.Failure error) (/.failure error))] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/module.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/module.lux index eccae999a..0af3736ac 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/module.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/module.lux @@ -254,8 +254,8 @@ _ (/.except ..cannot_declare_tags_for_unnamed_type [tags type])) _ (ensure_undeclared_tags self_name tags) - _ (///.assert cannot_declare_tags_for_foreign_type [tags type] - (text\= self_name type_module))] + _ (///.assertion cannot_declare_tags_for_foreign_type [tags type] + (text\= self_name type_module))] (///extension.lift (function (_ state) (case (|> state (get@ #.modules) (plist.get self_name)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux index 3804bcec2..acaf79ae9 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux @@ -138,11 +138,11 @@ (-> java/lang/ClassLoader External (Operation Any)) (do phase.monad [class (phase.lift (reflection!.load class_loader name))] - (phase.assert ..deprecated_class [name] - (|> class - java/lang/Class::getDeclaredAnnotations - reflection!.deprecated? - not)))) + (phase.assertion ..deprecated_class [name] + (|> class + java/lang/Class::getDeclaredAnnotations + reflection!.deprecated? + not)))) (def: reflection (All [category] @@ -930,17 +930,17 @@ ## else (do ! - [_ (phase.assert ..primitives_are_not_objects [from_name] - (not (dictionary.key? ..boxes from_name))) - _ (phase.assert ..primitives_are_not_objects [to_name] - (not (dictionary.key? ..boxes to_name))) + [_ (phase.assertion ..primitives_are_not_objects [from_name] + (not (dictionary.key? ..boxes from_name))) + _ (phase.assertion ..primitives_are_not_objects [to_name] + (not (dictionary.key? ..boxes to_name))) to_class (phase.lift (reflection!.load class_loader to_name)) _ (if (text\= ..inheritance_relationship_type_name from_name) (in []) (do ! [from_class (phase.lift (reflection!.load class_loader from_name))] - (phase.assert ..cannot_cast [fromT toT fromC] - (java/lang/Class::isAssignableFrom from_class to_class))))] + (phase.assertion ..cannot_cast [fromT toT fromC] + (java/lang/Class::isAssignableFrom from_class to_class))))] (loop [[current_name currentT] [from_name fromT]] (if (text\= to_name current_name) (in true) @@ -990,8 +990,8 @@ (do try.monad [class (reflection!.load class_loader class)] (reflection!.static_field field class))) - _ (phase.assert ..deprecated_field [class field] - (not deprecated?)) + _ (phase.assertion ..deprecated_field [class field] + (not deprecated?)) fieldT (reflection_type luxT.fresh fieldJT) _ (typeA.infer fieldT)] (in (<| (#/////analysis.Extension extension_name) @@ -1011,10 +1011,10 @@ (do try.monad [class (reflection!.load class_loader class)] (reflection!.static_field field class))) - _ (phase.assert ..deprecated_field [class field] - (not deprecated?)) - _ (phase.assert ..cannot_set_a_final_field [class field] - (not final?)) + _ (phase.assertion ..deprecated_field [class field] + (not deprecated?)) + _ (phase.assertion ..cannot_set_a_final_field [class field] + (not final?)) fieldT (reflection_type luxT.fresh fieldJT) valueA (typeA.with_type fieldT (analyse archive valueC))] @@ -1038,8 +1038,8 @@ [final? deprecated? fieldJT] (reflection!.virtual_field field class) mapping (reflection!.correspond class objectT)] (in [deprecated? mapping fieldJT]))) - _ (phase.assert ..deprecated_field [class field] - (not deprecated?)) + _ (phase.assertion ..deprecated_field [class field] + (not deprecated?)) fieldT (reflection_type mapping fieldJT) _ (typeA.infer fieldT)] (in (<| (#/////analysis.Extension extension_name) @@ -1064,10 +1064,10 @@ [final? deprecated? fieldJT] (reflection!.virtual_field field class) mapping (reflection!.correspond class objectT)] (in [final? deprecated? mapping fieldJT]))) - _ (phase.assert ..deprecated_field [class field] - (not deprecated?)) - _ (phase.assert ..cannot_set_a_final_field [class field] - (not final?)) + _ (phase.assertion ..deprecated_field [class field] + (not deprecated?)) + _ (phase.assertion ..cannot_set_a_final_field [class field] + (not final?)) fieldT (reflection_type mapping fieldJT) valueA (typeA.with_type fieldT (analyse archive valueC))] @@ -1376,8 +1376,8 @@ [_ (..ensure_fresh_class! class_loader class) #let [argsT (list\map product.left argsTC)] [methodT deprecated? exceptionsT] (..method_candidate class_loader class_tvars class method_tvars method #Static argsT) - _ (phase.assert ..deprecated_method [class method methodT] - (not deprecated?)) + _ (phase.assertion ..deprecated_method [class method methodT] + (not deprecated?)) [outputT argsA] (inferenceA.general archive analyse methodT (list\map product.right argsTC)) outputJT (check_return outputT)] (in (#/////analysis.Extension extension_name (list& (/////analysis.text (..signature (jvm.class class (list)))) @@ -1394,8 +1394,8 @@ [_ (..ensure_fresh_class! class_loader class) #let [argsT (list\map product.left argsTC)] [methodT deprecated? exceptionsT] (..method_candidate class_loader class_tvars class method_tvars method #Virtual argsT) - _ (phase.assert ..deprecated_method [class method methodT] - (not deprecated?)) + _ (phase.assertion ..deprecated_method [class method methodT] + (not deprecated?)) [outputT allA] (inferenceA.general archive analyse methodT (list& objectC (list\map product.right argsTC))) #let [[objectA argsA] (case allA (#.Item objectA argsA) @@ -1419,8 +1419,8 @@ [_ (..ensure_fresh_class! class_loader class) #let [argsT (list\map product.left argsTC)] [methodT deprecated? exceptionsT] (..method_candidate class_loader class_tvars class method_tvars method #Special argsT) - _ (phase.assert ..deprecated_method [class method methodT] - (not deprecated?)) + _ (phase.assertion ..deprecated_method [class method methodT] + (not deprecated?)) [outputT argsA] (inferenceA.general archive analyse methodT (list& objectC (list\map product.right argsTC))) outputJT (check_return outputT)] (in (#/////analysis.Extension extension_name (list& (/////analysis.text (..signature (jvm.class class (list)))) @@ -1437,11 +1437,11 @@ [_ (..ensure_fresh_class! class_loader class_name) #let [argsT (list\map product.left argsTC)] class (phase.lift (reflection!.load class_loader class_name)) - _ (phase.assert non_interface class_name - (java/lang/reflect/Modifier::isInterface (java/lang/Class::getModifiers class))) + _ (phase.assertion non_interface class_name + (java/lang/reflect/Modifier::isInterface (java/lang/Class::getModifiers class))) [methodT deprecated? exceptionsT] (..method_candidate class_loader class_tvars class_name method_tvars method #Interface argsT) - _ (phase.assert ..deprecated_method [class_name method methodT] - (not deprecated?)) + _ (phase.assertion ..deprecated_method [class_name method methodT] + (not deprecated?)) [outputT allA] (inferenceA.general archive analyse methodT (list& objectC (list\map product.right argsTC))) #let [[objectA argsA] (case allA (#.Item objectA argsA) @@ -1466,8 +1466,8 @@ [_ (..ensure_fresh_class! class_loader class) #let [argsT (list\map product.left argsTC)] [methodT deprecated? exceptionsT] (..constructor_candidate class_loader class_tvars class method_tvars argsT) - _ (phase.assert ..deprecated_method [class ..constructor_method methodT] - (not deprecated?)) + _ (phase.assertion ..deprecated_method [class ..constructor_method methodT] + (not deprecated?)) [outputT argsA] (inferenceA.general archive analyse methodT (list\map product.right argsTC))] (in (#/////analysis.Extension extension_name (list& (/////analysis.text (..signature (jvm.class class (list)))) (decorate_inputs argsT argsA))))))])) @@ -2064,9 +2064,9 @@ #let [expected_parameters (|> (java/lang/Class::getTypeParameters class) array.to_list (list\map (|>> java/lang/reflect/TypeVariable::getName)))] - _ (phase.assert ..class_parameter_mismatch [expected_parameters actual_parameters] - (n.= (list.size expected_parameters) - (list.size actual_parameters)))] + _ (phase.assertion ..class_parameter_mismatch [expected_parameters actual_parameters] + (n.= (list.size expected_parameters) + (list.size actual_parameters)))] (in (|> (list.zipped/2 expected_parameters actual_parameters) (list\fold (function (_ [expected actual] mapping) (case (jvm_parser.var? actual) @@ -2102,10 +2102,10 @@ methods) #let [missing_abstract_methods (mismatched_methods overriden_methods required_abstract_methods) invalid_overriden_methods (mismatched_methods available_methods overriden_methods)] - _ (phase.assert ..missing_abstract_methods missing_abstract_methods - (list.empty? missing_abstract_methods)) - _ (phase.assert ..invalid_overriden_methods invalid_overriden_methods - (list.empty? invalid_overriden_methods))] + _ (phase.assertion ..missing_abstract_methods missing_abstract_methods + (list.empty? missing_abstract_methods)) + _ (phase.assertion ..invalid_overriden_methods invalid_overriden_methods + (list.empty? invalid_overriden_methods))] (in []))) (def: (class::anonymous class_loader) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux index 94fe61c3e..5ac8a93ec 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux @@ -383,23 +383,23 @@ (_.return (..i64 (_.bit_not (_.the ..i64_high_field value)) (_.bit_not (_.the ..i64_low_field value))))) -(runtime: (i64//negate value) +(runtime: (i64//opposite value) (_.return (_.? (i64//= i64//min value) i64//min (i64//+ i64//one (i64//not value))))) (runtime: i64//-one - (i64//negate i64//one)) + (i64//opposite i64//one)) (runtime: (i64//of_number value) (_.return (<| (_.? (_.not_a_number? value) i64//zero) - (_.? (_.<= (_.negate i64//2^63) value) + (_.? (_.<= (_.opposite i64//2^63) value) i64//min) (_.? (|> value (_.+ (_.i32 +1)) (_.>= i64//2^63)) i64//max) (_.? (|> value (_.< (_.i32 +0))) - (|> value _.negate i64//of_number i64//negate)) + (|> value _.opposite i64//of_number i64//opposite)) (..i64 (|> value (_./ i64//2^32) _.to_i32) (|> value (_.% i64//2^32) _.to_i32))))) @@ -471,7 +471,7 @@ )) (runtime: (i64//- parameter subject) - (_.return (i64//+ (i64//negate parameter) subject))) + (_.return (i64//+ (i64//opposite parameter) subject))) (runtime: (i64//* parameter subject) (let [up_16 (_.left_shift (_.i32 +16)) @@ -577,13 +577,13 @@ [(negative? subject) (_.return (_.? (negative? parameter) - (i64/// (i64//negate parameter) - (i64//negate subject)) - (i64//negate (i64/// parameter - (i64//negate subject)))))] + (i64/// (i64//opposite parameter) + (i64//opposite subject)) + (i64//opposite (i64/// parameter + (i64//opposite subject)))))] [(negative? parameter) - (_.return (i64//negate (i64/// (i64//negate parameter) subject)))]) + (_.return (i64//opposite (i64/// (i64//opposite parameter) subject)))]) (with_vars [result remainder] ($_ _.then (_.define result i64//zero) @@ -645,7 +645,7 @@ @i64//one @i64//= @i64//+ - @i64//negate + @i64//opposite @i64//to_number @i64//of_number @i64//- diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/runtime.lux index dba43659e..0dcaf6ac8 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/runtime.lux @@ -280,16 +280,16 @@ (_.and (comparison i64_low)) isTRUE?))) -(runtime: (i64::negate input) +(runtime: (i64::opposite input) (_.if (|> input (i64::= i64::min)) i64::min (|> input i64::not (i64::+ i64::one)))) (runtime: i64::-one - (i64::negate i64::one)) + (i64::opposite i64::one)) (runtime: (i64::- param subject) - (i64::+ (i64::negate param) subject)) + (i64::+ (i64::opposite param) subject)) (runtime: (i64::< reference sample) (with_vars [r_? s_?] @@ -306,12 +306,12 @@ (runtime: (i64::of_float input) (_.cond (list [(_.apply (list input) (_.var "is.nan")) i64::zero] - [(|> input (_.<= (_.negate f2^63))) + [(|> input (_.<= (_.opposite f2^63))) i64::min] [(|> input (_.+ (_.float +1.0)) (_.>= f2^63)) i64::max] [(|> input (_.< (_.float +0.0))) - (|> input _.negate i64::of_float i64::negate)]) + (|> input _.opposite i64::of_float i64::opposite)]) (i64::new (|> input (_./ f2^32)) (|> input (_.%% f2^32))))) @@ -325,14 +325,14 @@ negative_param? (|> pH (_.< (_.int +0)))] (_.cond (list [negative_subject? (_.if negative_param? - (i64::* (i64::negate param) - (i64::negate subject)) - (i64::negate (i64::* param - (i64::negate subject))))] + (i64::* (i64::opposite param) + (i64::opposite subject)) + (i64::opposite (i64::* param + (i64::opposite subject))))] [negative_param? - (i64::negate (i64::* (i64::negate param) - subject))]) + (i64::opposite (i64::* (i64::opposite param) + subject))]) ($_ _.then (_.set! sL (|> subject i64_low)) (_.set! pL (|> param i64_low)) @@ -464,17 +464,17 @@ [(negative? subject) (_.if (negative? param) - (|> (i64::negate subject) - (i64::/ (i64::negate param))) - (|> (i64::negate subject) + (|> (i64::opposite subject) + (i64::/ (i64::opposite param))) + (|> (i64::opposite subject) (i64::/ param) - i64::negate))] + i64::opposite))] [(negative? param) (|> param - i64::negate + i64::opposite (i64::/ subject) - i64::negate)]) + i64::opposite)]) (with_vars [result remainder approximate approximate_result log2 approximate_remainder] ($_ _.then (_.set! result i64::zero) @@ -695,7 +695,7 @@ @i64::< @i64::+ @i64::- - @i64::negate + @i64::opposite @i64::-one @i64::unsigned_low @i64::to_float diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive.lux b/stdlib/source/library/lux/tool/compiler/meta/archive.lux index a87745390..a5a8826a0 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive.lux @@ -271,10 +271,10 @@ (-> Version Binary (Try Archive)) (do try.monad [[actual next reservations] (<binary>.run ..reader binary) - _ (exception.assert ..version_mismatch [expected actual] - (n\= expected actual)) - _ (exception.assert ..corrupt_data [] - (correct_reservations? reservations))] + _ (exception.assertion ..version_mismatch [expected actual] + (n\= expected actual)) + _ (exception.assertion ..corrupt_data [] + (correct_reservations? reservations))] (in (:abstraction {#next next #resolver (list\fold (function (_ [module id] archive) diff --git a/stdlib/source/library/lux/tool/compiler/phase.lux b/stdlib/source/library/lux/tool/compiler/phase.lux index 0554592a0..ed4def938 100644 --- a/stdlib/source/library/lux/tool/compiler/phase.lux +++ b/stdlib/source/library/lux/tool/compiler/phase.lux @@ -81,7 +81,7 @@ (function (_ state) (try\map (|>> [state]) error))) -(syntax: #export (assert exception message test) +(syntax: #export (assertion exception message test) (in (list (` (if (~ test) (\ ..monad (~' in) []) (..except (~ exception) (~ message))))))) diff --git a/stdlib/source/library/lux/type/check.lux b/stdlib/source/library/lux/type/check.lux index 03dd7b89e..121f1fb2f 100644 --- a/stdlib/source/library/lux/type/check.lux +++ b/stdlib/source/library/lux/type/check.lux @@ -171,7 +171,7 @@ (function (_ context) (#try.Failure message))) -(def: #export (assert message test) +(def: #export (assertion message test) (-> Text Bit (Check Any)) (function (_ context) (if test @@ -371,7 +371,7 @@ then) (do {! ..monad} [ring (..ring id) - _ (assert "" (n.> 1 (set.size ring))) + _ (..assertion "" (n.> 1 (set.size ring))) _ (monad.map ! (update type) (set.to_list ring))] then) (do ..monad diff --git a/stdlib/source/library/lux/type/implicit.lux b/stdlib/source/library/lux/type/implicit.lux index 2063b9de1..6141cadbb 100644 --- a/stdlib/source/library/lux/type/implicit.lux +++ b/stdlib/source/library/lux/type/implicit.lux @@ -6,8 +6,8 @@ ["." equivalence]] [control ["." try] - ["p" parser - ["s" code (#+ Parser)]]] + ["<>" parser + ["<.>" code (#+ Parser)]]] [data ["." product] ["." maybe] @@ -46,7 +46,7 @@ (meta.failure (format "Unknown type-var " (%.nat id))) )) -(def: (resolve_type var_name) +(def: (implicit_type var_name) (-> Name (Meta Type)) (do meta.monad [raw_type (meta.type var_name) @@ -110,14 +110,14 @@ _ (\ meta.monad in member))) -(def: (resolve_member member) +(def: (implicit_member member) (-> Name (Meta [Nat Type])) (do meta.monad [member (member_name member) [idx tag_list sig_type] (meta.resolve_tag member)] (in [idx sig_type]))) -(def: (prepare_definitions source_module target_module constants aggregate) +(def: (available_definitions source_module target_module constants aggregate) (-> Text Text (List [Text Definition]) (-> (List [Name Type]) (List [Name Type]))) (list\fold (function (_ [name [exported? def_type def_anns def_value]] aggregate) (if (and (annotation.implementation? def_anns) @@ -146,7 +146,7 @@ (do {! meta.monad} [this_module_name meta.current_module_name definitions (meta.definitions this_module_name)] - (in (prepare_definitions this_module_name this_module_name definitions #.End)))) + (in (available_definitions this_module_name this_module_name definitions #.End)))) (def: imported_structs (Meta (List [Name Type])) @@ -155,21 +155,23 @@ imported_modules (meta.imported_modules this_module_name) accessible_definitions (monad.map ! meta.definitions imported_modules)] (in (list\fold (function (_ [imported_module definitions] tail) - (prepare_definitions imported_module this_module_name definitions tail)) + (available_definitions imported_module this_module_name definitions tail)) #.End (list.zipped/2 imported_modules accessible_definitions))))) -(def: (apply_function_type func arg) +(def: (on_argument arg func) (-> Type Type (Check Type)) (case func (#.Named _ func') - (apply_function_type func' arg) + (on_argument arg func') (#.UnivQ _) (do check.monad [[id var] check.var] - (apply_function_type (maybe.assume (type.applied (list var) func)) - arg)) + (|> func + (type.applied (list var)) + maybe.assume + (on_argument arg))) (#.Function input output) (do check.monad @@ -192,21 +194,17 @@ _ (\ check.monad in [(list) type]))) -(def: (check_apply member_type input_types output_type) +(def: (ensure_function_application! member_type input_types expected_output) (-> Type (List Type) Type (Check [])) (do check.monad - [member_type' (monad.fold check.monad - (function (_ input member) - (apply_function_type member input)) - member_type - input_types)] - (check.check output_type member_type'))) + [actual_output (monad.fold check.monad ..on_argument member_type input_types)] + (check.check expected_output actual_output))) (type: #rec Instance {#constructor Name #dependencies (List Instance)}) -(def: (test_provision provision context dep alts) +(def: (candidate_provision provision context dep alts) (-> (-> Lux Type_Context Type (Check Instance)) Type_Context Type (List [Name Type]) (Meta (List Instance))) @@ -238,9 +236,9 @@ (-> Lux Type_Context Type (Check Instance)) (case (meta.run compiler ($_ meta.either - (do meta.monad [alts ..local_env] (..test_provision provision context dep alts)) - (do meta.monad [alts ..local_structs] (..test_provision provision context dep alts)) - (do meta.monad [alts ..imported_structs] (..test_provision provision context dep alts)))) + (do meta.monad [alts ..local_env] (..candidate_provision provision context dep alts)) + (do meta.monad [alts ..local_structs] (..candidate_provision provision context dep alts)) + (do meta.monad [alts ..imported_structs] (..candidate_provision provision context dep alts)))) (#.Left error) (check.failure error) @@ -256,23 +254,23 @@ (check.failure (format "Too many candidates for provisioning: " (%.type dep) " --- " (%.list (|>> product.left %.name) candidates)))) )) -(def: (test_alternatives sig_type member_idx input_types output_type alts) +(def: (candidate_alternatives sig_type member_idx input_types output_type alts) (-> Type Nat (List Type) Type (List [Name Type]) (Meta (List Instance))) (do meta.monad [compiler meta.get_compiler context meta.type_context] (case (|> alts (list\map (function (_ [alt_name alt_type]) - (case (check.run context - (do {! check.monad} - [[tvars alt_type] (concrete_type alt_type) - #let [[deps alt_type] (type.flat_function alt_type)] - _ (check.check alt_type sig_type) - member_type (member_type member_idx alt_type) - _ (check_apply member_type input_types output_type) - context' check.context - =deps (monad.map ! (provision compiler context') deps)] - (in =deps))) + (case (<| (check.run context) + (do {! check.monad} + [[tvars alt_type] (concrete_type alt_type) + #let [[deps alt_type] (type.flat_function alt_type)] + _ (check.check alt_type sig_type) + member_type (member_type member_idx alt_type) + _ (ensure_function_application! member_type input_types output_type) + context' check.context + =deps (monad.map ! (provision compiler context') deps)] + (in =deps))) (#.Left error) (list) @@ -287,7 +285,7 @@ (def: (alternatives sig_type member_idx input_types output_type) (-> Type Nat (List Type) Type (Meta (List Instance))) - (let [test (test_alternatives sig_type member_idx input_types output_type)] + (let [test (candidate_alternatives sig_type member_idx input_types output_type)] ($_ meta.either (do meta.monad [alts ..local_env] (test alts)) (do meta.monad [alts ..local_structs] (test alts)) @@ -302,7 +300,7 @@ _ #0)) -(def: (join_pair [l r]) +(def: (pair_list [l r]) (All [a] (-> [a a] (List a))) (list l r)) @@ -316,9 +314,9 @@ (` ((~ (code.identifier constructor)) (~+ (list\map instance$ dependencies)))))) (syntax: #export (\\ - {member s.identifier} - {args (p.or (p.and (p.some s.identifier) s.end!) - (p.and (p.some s.any) s.end!))}) + {member <code>.identifier} + {args (<>.or (<>.and (<>.some <code>.identifier) <code>.end!) + (<>.and (<>.some <code>.any) <code>.end!))}) {#.doc (doc "Automatic implementation selection (for type-class style polymorphism)." "This feature layers type-class style polymorphism on top of Lux's signatures and implementations." "When calling a polymorphic function, or using a polymorphic constant," @@ -345,8 +343,8 @@ (case args (#.Left [args _]) (do {! meta.monad} - [[member_idx sig_type] (resolve_member member) - input_types (monad.map ! resolve_type args) + [[member_idx sig_type] (..implicit_member member) + input_types (monad.map ! ..implicit_type args) output_type meta.expected_type chosen_ones (alternatives sig_type member_idx input_types output_type)] (case chosen_ones @@ -368,7 +366,7 @@ (#.Right [args _]) (do {! meta.monad} [labels (|> (macro.gensym "") (list.repeat (list.size args)) (monad.seq !))] - (in (list (` (let [(~+ (|> (list.zipped/2 labels args) (list\map join_pair) list\join))] + (in (list (` (let [(~+ (|> args (list.zipped/2 labels) (list\map ..pair_list) list\join))] (..\\ (~ (code.identifier member)) (~+ labels))))))) )) @@ -380,7 +378,7 @@ (def: implicits (Parser (List Code)) - (s.tuple (p.many s.any))) + (<code>.tuple (<>.many <code>.any))) (syntax: #export (with {implementations ..implicits} body) (do meta.monad diff --git a/stdlib/source/library/lux/type/resource.lux b/stdlib/source/library/lux/type/resource.lux index d0cee7d42..e68f820d0 100644 --- a/stdlib/source/library/lux/type/resource.lux +++ b/stdlib/source/library/lux/type/resource.lux @@ -143,8 +143,8 @@ (in (list)) (do ! [head <code>.nat - _ (<>.assert (exception.construct ..index_cannot_be_repeated head) - (not (set.member? seen head))) + _ (<>.assertion (exception.construct ..index_cannot_be_repeated head) + (not (set.member? seen head))) tail (recur (set.add head seen))] (in (list& head tail)))))))) @@ -192,8 +192,8 @@ (Parser Nat) (do <>.monad [raw <code>.nat - _ (<>.assert (exception.construct ..amount_cannot_be_zero []) - (n.> 0 raw))] + _ (<>.assertion (exception.construct ..amount_cannot_be_zero []) + (n.> 0 raw))] (in raw))) (template [<name> <m> <monad> <from> <to>] diff --git a/stdlib/source/library/lux/type/unit.lux b/stdlib/source/library/lux/type/unit.lux index 9d2bbd9bf..941c52167 100644 --- a/stdlib/source/library/lux/type/unit.lux +++ b/stdlib/source/library/lux/type/unit.lux @@ -106,11 +106,11 @@ (Parser Ratio) (<code>.tuple (do <>.monad [numerator <code>.nat - _ (<>.assert (format "Numerator must be positive: " (%.nat numerator)) - (n.> 0 numerator)) + _ (<>.assertion (format "Numerator must be positive: " (%.nat numerator)) + (n.> 0 numerator)) denominator <code>.nat - _ (<>.assert (format "Denominator must be positive: " (%.nat denominator)) - (n.> 0 denominator))] + _ (<>.assertion (format "Denominator must be positive: " (%.nat denominator)) + (n.> 0 denominator))] (in [numerator denominator])))) (syntax: #export (scale: diff --git a/stdlib/source/library/lux/world/file.lux b/stdlib/source/library/lux/world/file.lux index db20b54a4..2003b9804 100644 --- a/stdlib/source/library/lux/world/file.lux +++ b/stdlib/source/library/lux/world/file.lux @@ -76,7 +76,7 @@ )) )) -(def: #export (un_nest fs path) +(def: (un_rooted fs path) (All [!] (-> (System !) Path (Maybe [Path Text]))) (let [/ (\ fs separator)] (case (text.last_index_of / path) @@ -91,12 +91,14 @@ (def: #export (parent fs path) (All [!] (-> (System !) Path (Maybe Path))) - (|> (..un_nest fs path) + (|> path + (..un_rooted fs) (maybe\map product.left))) (def: #export (name fs path) (All [!] (-> (System !) Path Text)) - (|> (..un_nest fs path) + (|> path + (..un_rooted fs) (maybe\map product.right) (maybe.else path))) @@ -134,7 +136,7 @@ [move])) ))) -(def: #export (nest fs parent child) +(def: #export (rooted fs parent child) (All [!] (-> (System !) Path Text Path)) (format parent (\ fs separator) child)) @@ -1065,7 +1067,7 @@ #.End (exception.except ..cannot_find_file [path])))) -(def: (mock_delete! / path mock) +(def: (delete_mock_node! / path mock) (-> Text Path Mock (Try Mock)) (loop [directory mock trail (text.split_all_with / path)] @@ -1100,7 +1102,7 @@ #.End (exception.except ..cannot_delete [path])))) -(def: (try_update! transform var) +(def: (attempt! transform var) (All [a] (-> (-> a (Try a)) (Var a) (STM (Try Any)))) (do {! stm.monad} [|var| (stm.read var)] @@ -1260,35 +1262,35 @@ (def: (delete path) (stm.commit - (..try_update! (..mock_delete! separator path) store))) + (..attempt! (..delete_mock_node! separator path) store))) (def: (modify now path) (stm.commit - (..try_update! (function (_ |store|) - (do try.monad - [[name file] (..retrieve_mock_file! separator path |store|)] - (..update_mock_file! separator path now (get@ #mock_content file) |store|))) - store))) + (..attempt! (function (_ |store|) + (do try.monad + [[name file] (..retrieve_mock_file! separator path |store|)] + (..update_mock_file! separator path now (get@ #mock_content file) |store|))) + store))) (def: (write content path) (do async.monad [now (async.future instant.now)] (stm.commit - (..try_update! (..update_mock_file! separator path now content) store)))) + (..attempt! (..update_mock_file! separator path now content) store)))) (def: (append content path) (do async.monad [now (async.future instant.now)] (stm.commit - (..try_update! (function (_ |store|) - (do try.monad - [[name file] (..retrieve_mock_file! separator path |store|)] - (..update_mock_file! separator path now - (\ binary.monoid compose - (get@ #mock_content file) - content) - |store|))) - store)))) + (..attempt! (function (_ |store|) + (do try.monad + [[name file] (..retrieve_mock_file! separator path |store|)] + (..update_mock_file! separator path now + (\ binary.monoid compose + (get@ #mock_content file) + content) + |store|))) + store)))) (def: (move destination origin) (stm.commit @@ -1296,7 +1298,7 @@ [|store| (stm.read store)] (case (do try.monad [[name file] (..retrieve_mock_file! separator origin |store|) - |store| (..mock_delete! separator origin |store|)] + |store| (..delete_mock_node! separator origin |store|)] (..update_mock_file! separator destination (get@ #mock_last_modified file) (get@ #mock_content file) |store|)) (#try.Success |store|) (do ! |