diff options
Diffstat (limited to '')
73 files changed, 1191 insertions, 756 deletions
diff --git a/documentation/book/the_lux_programming_language/chapter_5.md b/documentation/book/the_lux_programming_language/chapter_5.md index 84fc98f76..675726a4a 100644 --- a/documentation/book/the_lux_programming_language/chapter_5.md +++ b/documentation/book/the_lux_programming_language/chapter_5.md @@ -370,5 +370,5 @@ You've only seen the basics of Lux and the next chapters are going to expose som Brace yourself, great power is coming! -See you in the next chapter! +See you in [the next chapter](chapter_6.md)! diff --git a/documentation/book/the_lux_programming_language/chapter_6.md b/documentation/book/the_lux_programming_language/chapter_6.md new file mode 100644 index 000000000..fbd8a8d8d --- /dev/null +++ b/documentation/book/the_lux_programming_language/chapter_6.md @@ -0,0 +1,316 @@ +# Chapter 6: Types in Detail + +_Where you will learn the truth behind types._ + +--- + +We've talked about Lux types already, but only in a very high-level way. + +On this chapter, you'll see how types are constructed, and hopefully that will give you some insight to understand better the subjects of later chapters. + +``` +(type: #export #rec Type + (#Primitive Text (List Type)) + (#Sum Type Type) + (#Product Type Type) + (#Function Type Type) + (#Parameter Nat) + (#Var Nat) + (#Ex Nat) + (#UnivQ (List Type) Type) + (#ExQ (List Type) Type) + (#Apply Type Type) + (#Named Name Type)) +``` + +This is the type of types. + +Crazy, right? + +But as I've said before, Lux types are values like any other. + +`Type` is a variant type, which just means that there are multiple options for type values. + +Also, you may have noticed that `#rec` tag in the definition. You need to add it whenever you're defining a recursive type that takes no parameters. + +So, the definition of `List` doesn't need it, but the definition of `Type` does. + +Let's go over each of them. + +--- + +``` +(#Primitive Text (List Type)) +``` + +This is what connects Lux's type-system with the host platform's. These types represent classes (in the JVM), with their respective parameters, if they have them (as would be the case for `ArrayList<Long>` in the JVM). + +--- + +``` +(#Sum Type Type) +(#Product Type Type) +``` + +You may have noticed that none of those options are called `#Variant` or `#Tuple`. The reason is that variants and tuples are just names for mathematical constructs called "sums" and "products". Funny names, right? + +Well, mathematicians see variants as a way of "adding" types and tuples as a way of "multiplying" types, Of course, it's a bit difficult to picture that if you're thinking of numbers. + +But a way to see variants is as an _"OR"_ operation for types: you get this option _OR_ that option. Conversely, tuples are like an _"AND"_ operation for types: you get this type _AND_ that type. + +But, you may be wondering: "why do `#Variant` and `#Tuple` only take 2 types, instead of a list like `#Primitive` does?" + +Well, as it turns out, you don't need a list of types to implement variants and tuples, because you can actually chain `#Variant` and `#Tuple` with other instances of themselves to get the same effect. + +What do I mean? + +Well, let me show you. To the left, you'll see the type as it's written in normal Lux code, and to the right you'll see the type value it generates. + +``` +(|) => Nothing +(| Bit) => Bit +(| Bit Int) => (#Sum Bit Int) +(| Bit Int Real) => (#Sum Bit (#Sum Int Real)) +(| Bit Int Real Char) => (#Sum Bit (#Sum Int (#Sum Real Char))) + +(&) => Any +(& Bit) => Bit +(& Bit Int) => (#Product Bit Int) +(& Bit Int Real) => (#Product Bit (#Product Int Real)) +(& Bit Int Real Char) => (#Product Bit (#Product Int (#Product Real Char))) +``` + +You can see where this is going. + +If I have a way to to pair up 2 types, and I can nest that, then I can chain things as much as I want to get the desired length. + +What is a variant/tuple of 1 type? It's just the type itself; no pairing required. + +This embedding means that [true 123 456.789 "X"] is the same as [true [123 456.789 "X"]], and the same as [true [123 [456.789 "X"]]]. + +It also means 5 is the same as [5], and [[5]], and [[[[[5]]]]]. + +As far as the compiler is concerned, there are no differences. + +That might sound crazy, but there are some really cool benefits to all of this. If you're curious about that, you can check out [Appendix E](appendix_e.md) for more information on how Lux handles this sort of stuff. + +And what happens when the variant/tuple has 0 types? That's when `Nothing` and `Any` come into play. + +`Nothing` is a type that has no instances; which is to say, there's no expression which can yield a value of such a type. + +It might seem oddd to have a type which has no instancces, but it can be useful to model computations which fail at runtime (thereby yielding no value). + +So, another way of thinking of `Nothing` is as the type of failed expressions. + +`Any`, on the other hand, is the opposite. + +You can think of it as the super-type of all other types: the type of all values. + +This means that not only `(: Nat 123)`, but also `(: Any 123)`. + +Since `Any` does not give you any specific information about a value, it only tells you that a value exists, regardless of what its specific type happens to be. + +So, whenever a function accepts or returns a dummy value of some kind, `Any` is a good candidate for that. + +An easy way to create values of type `Any` is with the _empty tuple_ syntax `[]`. + +In the same way that you cannot have empty tuple types, you also cannot make empty tuples. + +But Lux sees that syntax and just sticks some simple constant value in there for you. + +You might think that dummy values are, well, _dumb_, but they show up all the time. + +Consider the `Maybe` type: + +``` +(type: #export (Maybe a) + #None + (#Some a)) +``` + +The `#Some` tag holds values of type `a`, but what does `#None` hold? Nothing? + +Well, `Maybe` is a variant, which means it's a `#Sum`, which looks like this: + +``` +(#Sum Type Type) +``` + +So we know that `#None` must hold _something_. But what? + +Well, `Any`thing, really. + +So the type definition for `Maybe` is equivalent to this: + +``` +(type: #export (Maybe a) + (#None Any) + (#Some a)) +``` + +If you don't care what value you store somewhere, then you can store `Any` value in there. + +In practice, you can create instances of `Maybe` by writing this `(#None [])`, or `(#None 123)`, or just `#None`. + +If you only write the tag, then Lux treats it as if you paired it up with an empty tuple. + +So `#None` is equivalent to `(#None [])`. + +--- + +``` +(#Function Type Type) +``` + +Now that we have discussed variant and tuple types, it shouldn't come as a surprise that a similar trick can be done with function types. + +You see, if you can implement functions of 1 argument, you can implement functions of N arguments, where N > 1. + +All I need to do is to embed the rest of the function as the return value to the outer function. + + It might sound like this whole business of embedding tuples, variants and functions inside one another must be super inefficient; but trust me: Lux has taken care of that. + + The Lux compiler features many optimizations that compile things down in a way that gives you maximum efficiency. So, to a large extent, these embedded encodings are there for the semantics of the language, but not as something that you'll pay for at run-time. + +One of the cool benefits of this approach to functions is Lux's capacity to have partially applied functions. + +Yep, that's a direct consequence of this theoretical model. + +--- + +``` +(#Parameter Nat) +``` + +This type is there mostly for keeping track of type-parameters in _universal and existential quantification_. + +We'll talk about those later. But, suffice it to say that `#Parameter` helps them do their magic. + +--- + +``` +(#Var Nat) +``` + +These are type variables. + +They are used during type-inference by the compiler, but they're also part of what makes universal quantification (with the `All` macro) able to adjust itself to the types you use it with. + +Type-variables start _unbound_ (which means they're not associated with any type), but once they have been successfully matched with another type, they become bound to it, and every time you use them afterwards it's as if you're working with the original type. + +Type-variables, however, cannot be _re-bound_ once they have been set, to avoid inconsistencies during type-checking. + +--- + +``` +(#Ex Nat) +``` + +An existential type is an interesting concept (which is related, but not the same as existential quantification). + +You can see it as a type that exists, but is unknown to you. It's like receiving a type in a box you can't open. + +What can you do with it, then? You can compare it to other types, and the comparison will only succeed if it is matched against itself. + +It may sound like a useless thing, but it can power some advanced techniques. + +--- + +``` +(#UnivQ (List Type) Type) +``` + +This is what the `All` macro generates: _universal quantification_. + +That `(List Type)` you see there is meant to be the _context_ of the universal quantification. It's kind of like the environment of a function closure, only with types. + +The other `Type` there is the _body_ of the universal quantification. + +To understand better what's going on, let's transform the type of our `iterate_list` function from [Chapter 5](chapter_5.md) into its type value. + +``` +(All [a b] (-> (-> a b) (List a) (List b))) + +## => + +## (#.UnivQ #.End (#.UnivQ #.End (-> (-> (#.Parameter 3) (#.Parameter 1)) (List (#.Parameter 3)) (List (#.Parameter 1)))) +``` + + **Note**: I didn't transform the type entirely to avoid unnecessary verbosity. + +As you can see, I do the same embedding trick to have universal quantification with multiple parameters. + +Also, `a` and `b` are just nice syntactic labels that get transformed into `#Parameter` types. + + The reason the type-parameters have those IDs is due to a technique called [De Bruijn Indices](https://en.wikipedia.org/wiki/De_Bruijn_index). + +--- + +``` +(#ExQ (List Type) Type) +``` + +Existential quantification works pretty much the same way as universal quantification. + +Its associated macro is `Ex`. + +Whereas universal quantification works with type-variables, existential quantification works with existential types. + +--- + +``` +(#Apply Type Type) +``` + +This is the opposite of quantification. + +`#Apply` is what you use to parameterize your quantified types; to customize them as you need. + +With `#Apply`, `(List Int)` transforms into `(#Apply Int List)`. + +For multi-parameter types, like `Dictionary` (from `lux/data/collection/dictionary`), `(Dictionary Text User)` would become `(#Apply User (#Apply Text Dictionary))`. + + As you can see, the nesting is slightly different than how it is for tuples, variant and functions. + +--- + +``` +(#Named Name Type) +``` + +`#Named` is less of a necessity and more of a convenience. + +The type-system would work just fine without it, but users of the language probably wouldn't appreciate it while reading documentation or error messages. + +`#Named` is what gives the name _"List"_ to the `List` type, so you can actually read about it everywhere without getting bogged down in implementation details. + +You see, Lux's type system is structural in nature, rather than nominal (the dominating style in programming languages). + +That means all that matters is how a type is built; not what you call it. + +That implies 2 types with different names, but the exact same value, would actually type-check in your code. + +That may sound odd (if you come from Java or other languages with nominal types), but it's actually very convenient and enables you to do some pretty nifty tricks. + + For more information on that structural types, head over to [Appendix E](appendix_e.md). + +`#Named` gives Lux's type-system a bit of a nominal feel for the convenience of programmers. + +## Regarding Error Messages + +When you get error messages from the type-checker during your coding sessions, types will show up in intuitive ways most of the time, with a few exceptions you might want to know. + +Existential types show up in error messages like `⟨e:246⟩` (where 246 is the ID of the type). Whereas type-variables show up like `⌈v:278⌋`. + +Those types tend to show up when there are errors in the definition of some polymorphic function. + +--- + +You may be tired of reading about types, considering that they are (to a large degree) an implementation detail of the language. + +However, one of the key features of Lux is that types can be accessed and manipulated by programmers (often in macros) to implement various powerful features. + +In the next chapter, you'll get acquainted with one such feature. + +See you in the next chapter! + diff --git a/lux-mode/lux-mode.el b/lux-mode/lux-mode.el index 84896f3e5..2f5d197e7 100644 --- a/lux-mode/lux-mode.el +++ b/lux-mode/lux-mode.el @@ -325,7 +325,7 @@ Called by `imenu--generic-function'." (control//logic (altRE "and" "or")) (control//contract (altRE "pre" "post")) ;; Type - (type//syntax (altRE "|" "&" "->" "All" "Ex" "Rec" "primitive" "\\$" "type")) + (type//syntax (altRE "|" "&" "->" "All" "Ex" "Rec" "primitive" "type")) (type//checking (altRE ":" ":as" ":let" ":~" ":assume" ":of" ":cast" ":sharing" ":by_example" ":hole")) (type//abstract (altRE "abstract:" ":abstraction" ":representation" ":transmutation" "\\^:representation")) (type//unit (altRE "unit:" "scale:")) 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 ! diff --git a/stdlib/source/program/aedifex/dependency/resolution.lux b/stdlib/source/program/aedifex/dependency/resolution.lux index 97ed8eb4c..f793bfd1e 100644 --- a/stdlib/source/program/aedifex/dependency/resolution.lux +++ b/stdlib/source/program/aedifex/dependency/resolution.lux @@ -92,8 +92,8 @@ list.head (maybe.else output) (\ codec decode)) - _ (exception.assert exception [artifact extension output] - (\ ///hash.equivalence = (hash library) actual))] + _ (exception.assertion exception [artifact extension output] + (\ ///hash.equivalence = (hash library) actual))] (in (#.Some actual)))) (#try.Failure error) diff --git a/stdlib/source/specification/lux/world/file.lux b/stdlib/source/specification/lux/world/file.lux index 79eb871fe..147593f14 100644 --- a/stdlib/source/specification/lux/world/file.lux +++ b/stdlib/source/specification/lux/world/file.lux @@ -41,35 +41,17 @@ (do async.monad [fs (async.future fs)] ($_ _.and' - (_.cover' [/.un_nest] - (and (|> (/.un_nest fs parent) - (case> (#.Some _) - false - - #.None - true)) - (|> (/.un_nest fs child) - (case> (#.Some _) - false - - #.None - true)))) - (_.cover' [/.nest] - (|> (/.nest fs parent child) - (/.un_nest fs) - (case> (#.Some [parent' child']) - (and (text\= parent parent') - (text\= child child')) - - #.None - false))) + (_.cover' [/.rooted] + (let [path (/.rooted fs parent child)] + (and (text.starts_with? parent path) + (text.ends_with? child path)))) (_.cover' [/.parent] - (|> (/.nest fs parent child) + (|> (/.rooted fs parent child) (/.parent fs) (maybe\map (text\= parent)) (maybe.else false))) (_.cover' [/.name] - (|> (/.nest fs parent child) + (|> (/.rooted fs parent child) (/.name fs) (text\= child))) )))) @@ -138,8 +120,8 @@ (def: (directory_files&sub_directories fs parent sub_dir child) (-> (/.System Async) /.Path /.Path /.Path (Async Bit)) - (let [sub_dir (/.nest fs parent sub_dir) - child (/.nest fs parent child)] + (let [sub_dir (/.rooted fs parent sub_dir) + child (/.rooted fs parent child)] (do async.monad [made_sub? (\ fs make_directory sub_dir) directory_files (\ fs directory_files parent) @@ -157,8 +139,8 @@ (def: (move&delete fs parent child alternate_child) (-> (/.System Async) /.Path Text Text (Async Bit)) - (let [origin (/.nest fs parent child) - destination (/.nest fs parent alternate_child)] + (let [origin (/.rooted fs parent child) + destination (/.rooted fs parent alternate_child)] (do {! async.monad} [moved? (\ fs move destination origin) lost? (|> origin @@ -191,7 +173,7 @@ in (do {! async.monad} [fs (async.future fs) - #let [path (/.nest fs parent child)] + #let [path (/.rooted fs parent child)] directory?&make_directory (..directory?&make_directory fs parent) @@ -233,8 +215,8 @@ in (do {! async.monad} [fs (async.future fs) - #let [dir/1 (/.nest fs dir/0 dir/1) - dir/2 (/.nest fs dir/1 dir/2)] + #let [dir/1 (/.rooted fs dir/0 dir/1) + dir/2 (/.rooted fs dir/1 dir/2)] pre_dir/0 (\ fs directory? dir/0) pre_dir/1 (\ fs directory? dir/1) pre_dir/2 (\ fs directory? dir/2) diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index 04f6bea3f..793fd23b3 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -409,6 +409,13 @@ (/.macro: (identity_macro tokens) (\ meta.monad in tokens)) +(def: crosshair + "This is an arbitrary text whose only purpose is to be found, somewhere, in the source-code.") + +(/.macro: (found_crosshair? tokens lux) + (let [[_ _ source_code] (get@ #.source lux)] + (#.Right [lux (list (code.bit (text.contains? ..crosshair source_code)))]))) + (def: for_macro Test (let [macro (: /.Macro' @@ -429,6 +436,8 @@ (is? (: Any macro)))) (_.cover [/.macro:] (is? expected (..identity_macro expected))) + (_.cover [/.Source] + (..found_crosshair?)) )))) (/.type: for_type/variant diff --git a/stdlib/source/test/lux/control/exception.lux b/stdlib/source/test/lux/control/exception.lux index 1ab4cf0e5..7b1643b79 100644 --- a/stdlib/source/test/lux/control/exception.lux +++ b/stdlib/source/test/lux/control/exception.lux @@ -55,8 +55,8 @@ (_.cover [/.match?] (/.match? ..an_exception (/.construct ..an_exception []))) - (_.cover [/.assert] - (case (/.assert ..an_exception [] assertion_succeeded?) + (_.cover [/.assertion] + (case (/.assertion ..an_exception [] assertion_succeeded?) (#try.Success _) assertion_succeeded? diff --git a/stdlib/source/test/lux/control/parser.lux b/stdlib/source/test/lux/control/parser.lux index 209944969..717202488 100644 --- a/stdlib/source/test/lux/control/parser.lux +++ b/stdlib/source/test/lux/control/parser.lux @@ -373,12 +373,12 @@ (|> (list) (/.run (/.lift (#try.Failure failure))) (should_fail failure)))) - (_.cover [/.assert] + (_.cover [/.assertion] (and (|> (list (code.bit #1) (code.int +123)) - (/.run (/.assert assertion #1)) + (/.run (/.assertion assertion #1)) (match [] true)) (|> (list (code.bit #1) (code.int +123)) - (/.run (/.assert assertion #0)) + (/.run (/.assertion assertion #0)) fails?))) ..combinators_0 ..combinators_1 diff --git a/stdlib/source/test/lux/data/text/regex.lux b/stdlib/source/test/lux/data/text/regex.lux index 52053f108..ea81e2c77 100644 --- a/stdlib/source/test/lux/data/text/regex.lux +++ b/stdlib/source/test/lux/data/text/regex.lux @@ -7,17 +7,17 @@ [control pipe ["." try] - ["p" parser - ["<.>" text (#+ Parser)] - ["s" code]]] + [parser + ["<.>" text (#+ Parser)]]] [data ["." text ("#\." equivalence) ["%" format (#+ format)]]] + ["." macro + [syntax (#+ syntax:)] + ["." code]] [math [number (#+ hex)] - ["." random]] - ["." macro - [syntax (#+ syntax:)]]]] + ["." random]]]] [\\library ["." /]]) @@ -269,6 +269,15 @@ "123-456-7890"))) )) +(syntax: (expands? form) + (function (_ lux) + (#try.Success [lux (list (code.bit (case (macro.single_expansion form lux) + (#try.Success _) + true + + (#try.Failure error) + false)))]))) + (def: #export test Test (<| (_.covering /._) @@ -299,4 +308,7 @@ _ false))) + (_.cover [/.incorrect_quantification] + (and (expands? (/.regex "a{1,2}")) + (not (expands? (/.regex "a{2,1}"))))) ))) diff --git a/stdlib/source/test/lux/data/text/unicode/block.lux b/stdlib/source/test/lux/data/text/unicode/block.lux index d08f41fa8..9588ce6ce 100644 --- a/stdlib/source/test/lux/data/text/unicode/block.lux +++ b/stdlib/source/test/lux/data/text/unicode/block.lux @@ -24,10 +24,10 @@ (def: #export random (Random /.Block) - (do random.monad - [start random.nat - end random.nat] - (in (/.block start end)))) + (do {! random.monad} + [start (\ ! map (n.% 1,000,000) random.nat) + additional (\ ! map (n.% 1,000,000) random.nat)] + (in (/.block start additional)))) (with_expansions [<blocks> (as_is [blocks/0 [/.basic_latin @@ -171,10 +171,12 @@ (_.for [/.Block]) (do {! random.monad} [#let [top_start (hex "AC00") - top_end (hex "D7AF")] + top_end (hex "D7AF") + end_range (n.- top_start top_end)] start (\ ! map (|>> (n.% top_start) inc) random.nat) - end (\ ! map (|>> (n.% top_end) inc) random.nat) - #let [sample (/.block start end) + end (\ ! map (|>> (n.% end_range) (n.+ top_start)) random.nat) + #let [additional (n.- start end) + sample (/.block start additional) size (/.size sample)] inside (\ ! map (|>> (n.% size) @@ -188,27 +190,24 @@ (_.for [/.monoid] ($monoid.spec /.equivalence /.monoid ..random)) - (_.cover [/.block] - (\ /.equivalence = - (/.block start end) - (/.block end start))) - (_.cover [/.start] - (n.= (n.min start end) - (/.start (/.block start end)))) - (_.cover [/.end] - (n.= (n.max start end) - (/.end (/.block start end)))) - (_.cover [/.size] - (n.= (inc (n.- (n.min start end) - (n.max start end))) - (/.size (/.block start end)))) - (_.cover [/.within?] - (and (/.within? sample inside) - (not (/.within? sample (dec (/.start sample)))) - (not (/.within? sample (inc (/.end sample)))))) - (~~ (template [<definition> <part>] - [<definition>] - - <blocks>)) + (_.for [/.block] + ($_ _.and + (_.cover [/.start] + (n.= start + (/.start sample))) + (_.cover [/.end] + (n.= end + (/.end sample))) + (_.cover [/.size] + (n.= (inc additional) + (/.size sample))) + (_.cover [/.within?] + (and (/.within? sample inside) + (not (/.within? sample (dec (/.start sample)))) + (not (/.within? sample (inc (/.end sample)))))) + (~~ (template [<definition> <part>] + [<definition>] + + <blocks>)))) ))))) ) diff --git a/stdlib/source/test/lux/data/text/unicode/set.lux b/stdlib/source/test/lux/data/text/unicode/set.lux index 054c6c6f7..cd74a038c 100644 --- a/stdlib/source/test/lux/data/text/unicode/set.lux +++ b/stdlib/source/test/lux/data/text/unicode/set.lux @@ -48,34 +48,36 @@ (_.for [/.equivalence] ($equivalence.spec /.equivalence ..random)) - (_.cover [/.range] - (let [[start end] (/.range (/.set [left (list right)]))] - (and (n.= (n.min (block.start left) - (block.start right)) - start) - (n.= (n.max (block.end left) - (block.end right)) - end)))) + (_.cover [/.set] + (and (n.= (block.start left) + (/.start (/.set [left (list)]))) + (n.= (block.end left) + (/.end (/.set [left (list)]))))) + (_.cover [/.start] + (n.= (n.min (block.start left) + (block.start right)) + (/.start (/.set [left (list right)])))) + (_.cover [/.end] + (n.= (n.max (block.end left) + (block.end right)) + (/.end (/.set [left (list right)])))) (_.cover [/.member?] (bit\= (block.within? block inside) (/.member? (/.set [block (list)]) inside))) (_.cover [/.compose] - (\ equivalence = - [(n.min (block.start left) - (block.start right)) - (n.max (block.end left) - (block.end right))] - (/.range (/.compose (/.set [left (list)]) - (/.set [right (list)]))))) - (_.cover [/.set] - (\ equivalence = - (/.range (/.compose (/.set [left (list)]) - (/.set [right (list)]))) - (/.range (/.set [left (list right)])))) + (let [composed (/.compose (/.set [left (list)]) + (/.set [right (list)]))] + (and (n.= (n.min (block.start left) + (block.start right)) + (/.start composed)) + (n.= (n.max (block.end left) + (block.end right)) + (/.end composed))))) (~~ (template [<set>] [(do random.monad [char (random.char <set>) - #let [[start end] (/.range <set>)]] + #let [start (/.start <set>) + end (/.end <set>)]] (_.cover [<set>] (and (/.member? <set> char) (not (/.member? <set> (dec start))) diff --git a/stdlib/source/test/lux/math.lux b/stdlib/source/test/lux/math.lux index db314f400..96ba96e35 100644 --- a/stdlib/source/test/lux/math.lux +++ b/stdlib/source/test/lux/math.lux @@ -112,13 +112,13 @@ big (\ ! map (f.* +1,000,000,000.00) random.safe_frac)] (template.let [(odd! <function>) [(_.cover [<function>] - (~= (f.negate (<function> angle)) - (<function> (f.negate angle))))] + (~= (f.opposite (<function> angle)) + (<function> (f.opposite angle))))] (even! <function>) [(_.cover [<function>] (~= (<function> angle) - (<function> (f.negate angle))))] + (<function> (f.opposite angle))))] (inverse! <left> <right> <input>) [(_.cover [<left> <right>] @@ -157,7 +157,7 @@ (f.+ /.pi (/.atan (f./ x y)))))] (and (~= expected actual) (~= tau/4 (/.atan/2 +0.0 (f.abs y))) - (~= (f.negate tau/4) (/.atan/2 +0.0 (f.negate (f.abs y)))) + (~= (f.opposite tau/4) (/.atan/2 +0.0 (f.opposite (f.abs y)))) (f.not_a_number? (/.atan/2 +0.0 +0.0)))))) (do {! random.monad} [of (\ ! map (|>> (n.% 10) inc) random.nat)] diff --git a/stdlib/source/test/lux/math/number/complex.lux b/stdlib/source/test/lux/math/number/complex.lux index e5f43c47d..ddeb53c2f 100644 --- a/stdlib/source/test/lux/math/number/complex.lux +++ b/stdlib/source/test/lux/math/number/complex.lux @@ -177,7 +177,7 @@ (let [cx (/.conjugate x)] (and (f.= (get@ #/.real x) (get@ #/.real cx)) - (f.= (f.negate (get@ #/.imaginary x)) + (f.= (f.opposite (get@ #/.imaginary x)) (get@ #/.imaginary cx))))) (_.cover [/.reciprocal] (let [reciprocal! @@ -193,16 +193,16 @@ (or (f.= +0.0 signum_abs) (f.= +1.0 signum_abs) (f.= (math.pow +0.5 +2.0) signum_abs)))) - (_.cover [/.negate] + (_.cover [/.opposite] (let [own_inverse! - (let [there (/.negate x) - back_again (/.negate there)] + (let [there (/.opposite x) + back_again (/.opposite there)] (and (not (/.= there x)) (/.= back_again x))) absolute! (f.= (/.abs x) - (/.abs (/.negate x)))] + (/.abs (/.opposite x)))] (and own_inverse! absolute!))) ))) diff --git a/stdlib/source/test/lux/math/number/frac.lux b/stdlib/source/test/lux/math/number/frac.lux index 41f1bc29c..2a8e65062 100644 --- a/stdlib/source/test/lux/math/number/frac.lux +++ b/stdlib/source/test/lux/math/number/frac.lux @@ -148,7 +148,7 @@ (_.cover [/.-] (and (/.= +0.0 (/.- sample sample)) (/.= sample (/.- +0.0 sample)) - (/.= (/.negate sample) + (/.= (/.opposite sample) (/.- sample +0.0)))) (_.cover [/./] (and (/.= +1.0 (/./ sample sample)) @@ -229,12 +229,12 @@ (test /.negative_infinity))))))) (do random.monad [expected random.safe_frac] - (_.cover [/.negate] + (_.cover [/.opposite] (let [subtraction! - (/.= +0.0 (/.+ (/.negate expected) expected)) + (/.= +0.0 (/.+ (/.opposite expected) expected)) inverse! - (|> expected /.negate /.negate (/.= expected))] + (|> expected /.opposite /.opposite (/.= expected))] (and subtraction! inverse!)))) diff --git a/stdlib/source/test/lux/math/number/int.lux b/stdlib/source/test/lux/math/number/int.lux index d7d3d6122..18f46233a 100644 --- a/stdlib/source/test/lux/math/number/int.lux +++ b/stdlib/source/test/lux/math/number/int.lux @@ -84,7 +84,7 @@ (_.cover [/.-] (and (/.= +0 (/.- sample sample)) (/.= sample (/.- +0 sample)) - (/.= (/.negate sample) + (/.= (/.opposite sample) (/.- sample +0)))) (_.cover [/./] (and (/.= +1 (/./ sample sample)) @@ -168,12 +168,12 @@ )) (do random.monad [expected random.int] - (_.cover [/.negate] + (_.cover [/.opposite] (let [subtraction! - (/.= +0 (/.+ (/.negate expected) expected)) + (/.= +0 (/.+ (/.opposite expected) expected)) inverse! - (|> expected /.negate /.negate (/.= expected))] + (|> expected /.opposite /.opposite (/.= expected))] (and subtraction! inverse!)))) (do {! random.monad} diff --git a/stdlib/source/test/lux/meta.lux b/stdlib/source/test/lux/meta.lux index 2356772ec..92f88dfc6 100644 --- a/stdlib/source/test/lux/meta.lux +++ b/stdlib/source/test/lux/meta.lux @@ -121,12 +121,12 @@ (!expect (^multi (#try.Failure actual_error) (text\= (location.with location.dummy expected_error) actual_error))))) - (_.cover [/.assert] - (and (|> (/.assert expected_error true) + (_.cover [/.assertion] + (and (|> (/.assertion expected_error true) (: (Meta Any)) (/.run expected_lux) (!expect (#try.Success []))) - (|> (/.assert expected_error false) + (|> (/.assertion expected_error false) (/.run expected_lux) (!expect (^multi (#try.Failure actual_error) (text\= expected_error actual_error)))))) diff --git a/stdlib/source/test/lux/test.lux b/stdlib/source/test/lux/test.lux index e938dafd6..04a4d0734 100644 --- a/stdlib/source/test/lux/test.lux +++ b/stdlib/source/test/lux/test.lux @@ -36,9 +36,9 @@ (random.ascii/lower 5))] ($_ /.and (in (do async.monad - [[success_tally success_message] (/.assert expected_message/0 true) - [failure_tally failure_message] (/.assert expected_message/0 false)] - (/.cover' [/.assert /.Tally] + [[success_tally success_message] (/.assertion expected_message/0 true) + [failure_tally failure_message] (/.assertion expected_message/0 false)] + (/.cover' [/.assertion /.Tally] (and (text.ends_with? expected_message/0 success_message) (text.ends_with? expected_message/0 failure_message) (and (n.= 1 (get@ #/.successes success_tally)) @@ -46,14 +46,14 @@ (and (n.= 0 (get@ #/.successes failure_tally)) (n.= 1 (get@ #/.failures failure_tally))))))) (in (do async.monad - [tt (/.and' (/.assert expected_message/0 true) - (/.assert expected_message/1 true)) - ff (/.and' (/.assert expected_message/0 false) - (/.assert expected_message/1 false)) - tf (/.and' (/.assert expected_message/0 true) - (/.assert expected_message/1 false)) - ft (/.and' (/.assert expected_message/0 false) - (/.assert expected_message/1 true))] + [tt (/.and' (/.assertion expected_message/0 true) + (/.assertion expected_message/1 true)) + ff (/.and' (/.assertion expected_message/0 false) + (/.assertion expected_message/1 false)) + tf (/.and' (/.assertion expected_message/0 true) + (/.assertion expected_message/1 false)) + ft (/.and' (/.assertion expected_message/0 false) + (/.assertion expected_message/1 true))] (/.cover' [/.and'] (and (..verify expected_message/0 expected_message/1 2 0 tt) (..verify expected_message/0 expected_message/1 0 2 ff) @@ -77,7 +77,7 @@ [actual random.nat] (in (do async.monad [expected read] - (/.assert "" (n.= expected actual))))))] + (/.assertion "" (n.= expected actual))))))] (in (do async.monad [[pre_tally pre_message] pre [post_tally post_message] post] diff --git a/stdlib/source/test/lux/type/check.lux b/stdlib/source/test/lux/type/check.lux index a7cac630c..6172608b3 100644 --- a/stdlib/source/test/lux/type/check.lux +++ b/stdlib/source/test/lux/type/check.lux @@ -129,13 +129,13 @@ (#try.Failure actual) (is? expected actual)))) (do random.monad [expected (random.ascii/upper 10)] - (_.cover [/.assert] + (_.cover [/.assertion] (and (case (/.run /.fresh_context (: (/.Check Any) - (/.assert expected true))) + (/.assertion expected true))) (#try.Success _) true (#try.Failure actual) false) - (case (/.run /.fresh_context (/.assert expected false)) + (case (/.run /.fresh_context (/.assertion expected false)) (#try.Success _) false (#try.Failure actual) (is? expected actual))))) (_.cover [/.except] @@ -442,8 +442,8 @@ _ (/.check var/head nominal/0) failures (monad.map ! (|>> (/.check nominal/1) ..verdict) (list& var/head var/tail+)) successes (monad.map ! (|>> (/.check nominal/0) ..verdict) (list& var/head var/tail+))] - (/.assert "" (and (list.every? (bit\= false) failures) - (list.every? (bit\= true) successes))))) + (/.assertion "" (and (list.every? (bit\= false) failures) + (list.every? (bit\= true) successes))))) can_merge_multiple_rings_of_variables! (succeeds? (do {! /.monad} @@ -455,8 +455,8 @@ (list& var/head/1 var/tail+/1))] failures (monad.map ! (|>> (/.check nominal/1) ..verdict) all_variables) successes (monad.map ! (|>> (/.check nominal/0) ..verdict) all_variables)] - (/.assert "" (and (list.every? (bit\= false) failures) - (list.every? (bit\= true) successes)))))] + (/.assertion "" (and (list.every? (bit\= false) failures) + (list.every? (bit\= true) successes)))))] (and can_create_rings_of_variables! can_bind_rings_of_variables! can_merge_multiple_rings_of_variables!))) |