diff options
Diffstat (limited to 'stdlib')
| -rw-r--r-- | stdlib/source/lux.lux | 11 | ||||
| -rw-r--r-- | stdlib/source/lux/control/concatenative.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/lux/data/coll/tree/parser.lux | 50 | ||||
| -rw-r--r-- | stdlib/source/lux/data/coll/tree/zipper.lux | 68 | ||||
| -rw-r--r-- | stdlib/source/lux/data/format/xml.lux | 140 | ||||
| -rw-r--r-- | stdlib/source/lux/math.lux | 89 | ||||
| -rw-r--r-- | stdlib/test/test/lux/data/coll/tree/zipper.lux | 73 | ||||
| -rw-r--r-- | stdlib/test/test/lux/data/format/xml.lux | 49 | ||||
| -rw-r--r-- | stdlib/test/test/lux/math.lux | 33 | ||||
| -rw-r--r-- | stdlib/test/tests.lux | 11 |
10 files changed, 365 insertions, 161 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index 641e8693d..6b29d7c42 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -5603,10 +5603,10 @@ (macro: #export (undefined tokens) {#;doc (doc "Meant to be used as a stand-in for functions with undefined implementations." "Undefined expressions will type-check against everything, so they make good dummy implementations." + "However, if an undefined expression is ever evaluated, it will raise a runtime error." (def: (square x) (-> Int Int) - (undefined)) - "If an undefined expression is ever evaluated, it will raise an error.")} + (undefined)))} (case tokens #;Nil (return (list (` (error! "Undefined behavior.")))) @@ -5761,3 +5761,10 @@ _ (#;Left "Wrong syntax for char"))) + +(def: #export (when test f) + (All [a] (-> Bool (-> a a) (-> a a))) + (function [value] + (if test + (f value) + value))) diff --git a/stdlib/source/lux/control/concatenative.lux b/stdlib/source/lux/control/concatenative.lux index 61a6ddbd0..cdb9cc457 100644 --- a/stdlib/source/lux/control/concatenative.lux +++ b/stdlib/source/lux/control/concatenative.lux @@ -1,4 +1,4 @@ -(;module: [lux #- if loop +(;module: [lux #- if loop when n.+ n.- n.* n./ n.% n.= n.< n.<= n.> n.>= i.+ i.- i.* i./ i.% i.= i.< i.<= i.> i.>= d.+ d.- d.* d./ d.% d.= d.< d.<= d.> d.>= diff --git a/stdlib/source/lux/data/coll/tree/parser.lux b/stdlib/source/lux/data/coll/tree/parser.lux new file mode 100644 index 000000000..203f55b16 --- /dev/null +++ b/stdlib/source/lux/data/coll/tree/parser.lux @@ -0,0 +1,50 @@ +(;module: + lux + (lux (control ["p" parser] + ["ex" exception #+ exception:]) + (data ["R" result])) + (.. ["T" rose] + ["Z" zipper])) + +(type: #export (Parser t a) + (p;Parser (Z;Zipper t) a)) + +(def: #export (run-zipper zipper parser) + (All [t a] (-> (Z;Zipper t) (Parser t a) (R;Result a))) + (case (p;run zipper parser) + (#R;Success [zipper output]) + (#R;Success output) + + (#R;Error error) + (#R;Error error))) + +(def: #export (run tree parser) + (All [t a] (-> (T;Tree t) (Parser t a) (R;Result a))) + (run-zipper (Z;zip tree) parser)) + +(def: #export value + (All [t] (Parser t t)) + (function [zipper] + (#R;Success [zipper (Z;value zipper)]))) + +(exception: #export Cannot-Move-Further) + +(do-template [<name> <direction>] + [(def: #export <name> + (All [t] (Parser t [])) + (function [zipper] + (let [next (<direction> zipper)] + (if (is zipper next) + (ex;throw Cannot-Move-Further "") + (#R;Success [next []])))))] + + [up Z;up] + [down Z;down] + [left Z;left] + [right Z;right] + [root Z;root] + [rightmost Z;rightmost] + [leftmost Z;leftmost] + [next Z;next] + [prev Z;prev] + ) diff --git a/stdlib/source/lux/data/coll/tree/zipper.lux b/stdlib/source/lux/data/coll/tree/zipper.lux index b217a0677..6b39178bc 100644 --- a/stdlib/source/lux/data/coll/tree/zipper.lux +++ b/stdlib/source/lux/data/coll/tree/zipper.lux @@ -21,24 +21,24 @@ #node (Tree a)}) ## [Values] -(def: #export (from-tree tree) +(def: #export (zip tree) (All [a] (-> (Tree a) (Zipper a))) {#parent #;None #lefts stack;empty #rights stack;empty #node tree}) -(def: #export (to-tree zipper) +(def: #export (unzip zipper) (All [a] (-> (Zipper a) (Tree a))) (get@ #node zipper)) (def: #export (value zipper) (All [a] (-> (Zipper a) a)) - (|> zipper (get@ #node) (get@ #rose;value))) + (|> zipper (get@ [#node #rose;value]))) (def: #export (children zipper) (All [a] (-> (Zipper a) (List (Tree a)))) - (|> zipper (get@ #node) (get@ #rose;children))) + (|> zipper (get@ [#node #rose;children]))) (def: #export (branch? zipper) (All [a] (-> (Zipper a) Bool)) @@ -48,9 +48,19 @@ (All [a] (-> (Zipper a) Bool)) (|> zipper branch? not)) -(def: #export (parent zipper) - (All [a] (-> (Zipper a) (Maybe (Zipper a)))) - (get@ #parent zipper)) +(def: #export (end? zipper) + (All [a] (-> (Zipper a) Bool)) + (and (list;empty? (get@ #rights zipper)) + (list;empty? (children zipper)))) + +(def: #export (root? zipper) + (All [a] (-> (Zipper a) Bool)) + (case (get@ #parent zipper) + #;None + true + + _ + false)) (def: #export (down zipper) (All [a] (-> (Zipper a) (Zipper a))) @@ -108,6 +118,20 @@ [left leftmost #lefts #rights] ) +(do-template [<name> <h-side> <h-op> <v-op>] + [(def: #export (<name> zipper) + (All [a] (-> (Zipper a) (Zipper a))) + (case (get@ <h-side> zipper) + #;Nil + (<v-op> zipper) + + _ + (<h-op> zipper)))] + + [next #rights right down] + [prev #lefts left up] + ) + (def: #export (set value zipper) (All [a] (-> a (Zipper a) (Zipper a))) (set@ [#node #rose;value] value zipper)) @@ -169,34 +193,6 @@ [insert-right #rights] ) -(do-template [<name> <h-side> <h-op> <v-op>] - [(def: #export (<name> zipper) - (All [a] (-> (Zipper a) (Zipper a))) - (case (get@ <h-side> zipper) - #;Nil - (<v-op> zipper) - - _ - (<h-op> zipper)))] - - [next #rights right down] - [prev #lefts left up] - ) - -(def: #export (end? zipper) - (All [a] (-> (Zipper a) Bool)) - (and (list;empty? (get@ #rights zipper)) - (list;empty? (children zipper)))) - -(def: #export (root? zipper) - (All [a] (-> (Zipper a) Bool)) - (case (get@ #parent zipper) - #;None - true - - _ - false)) - (struct: #export _ (Functor Zipper) (def: (map f fa) {#parent (|> fa (get@ #parent) (M/map (map f))) @@ -211,7 +207,7 @@ ## (def: (split wa) ## (let [tree-splitter (function tree-splitter [tree] -## {#rose;value (from-tree tree) +## {#rose;value (zip tree) ## #rose;children (L/map tree-splitter ## (get@ #rose;children tree))})] ## {#parent (|> wa (get@ #parent) (M/map split)) diff --git a/stdlib/source/lux/data/format/xml.lux b/stdlib/source/lux/data/format/xml.lux index 4ff38380f..dc6074ef5 100644 --- a/stdlib/source/lux/data/format/xml.lux +++ b/stdlib/source/lux/data/format/xml.lux @@ -3,37 +3,28 @@ (lux (control monad [eq #+ Eq] codec - ["p" parser "p/" Monad<Parser>]) + ["p" parser "p/" Monad<Parser>] + ["ex" exception #+ exception:]) (data [text "text/" Eq<Text> Monoid<Text>] (text ["l" lexer]) [number] ["R" result] [product] [maybe "m/" Monad<Maybe>] - [ident "Ident/" Eq<Ident> Codec<Text,Ident>] + [ident "ident/" Eq<Ident> Codec<Text,Ident>] (coll [list "L/" Monad<List>] - ["d" dict] - (tree ["T" rose] - ["Z" zipper]))) + ["d" dict])) )) -## [Types] (type: #export Tag Ident) (type: #export Attrs (d;Dict Ident Text)) +(def: #export attrs Attrs (d;new ident;Hash<Ident>)) + (type: #export #rec XML (#Text Text) (#Node Tag Attrs (List XML))) -(def: #export (text value) - (-> Text XML) - (#Text value)) - -(def: #export (node tag attrs children) - (-> Tag Attrs (List XML) XML) - (#Node tag attrs children)) - -## [Parsing] (def: xml-standard-escape-char^ (l;Lexer Text) ($_ p;either @@ -119,9 +110,9 @@ (p;after (l;this "/")) (l;enclosed ["<" ">"]))] (p;assert ($_ text/append "Close tag does not match open tag.\n" - "Expected: " (Ident/encode expected) "\n" - " Actual: " (Ident/encode actual) "\n") - (Ident/= expected actual)))) + "Expected: " (ident/encode expected) "\n" + " Actual: " (ident/encode actual) "\n") + (ident/= expected actual)))) (def: comment^ (l;Lexer Text) @@ -163,12 +154,12 @@ attrs (spaced^ attrs^) #let [no-children^ (do p;Monad<Parser> [_ (l;this "/>")] - (wrap (node tag attrs (list)))) + (wrap (#Node tag attrs (list)))) with-children^ (do p;Monad<Parser> [_ (l;this ">") children (p;some node^) _ (close-tag^ tag)] - (wrap (node tag attrs children)))]] + (wrap (#Node tag attrs children)))]] (p;either no-children^ with-children^)))))) ## This is put outside of the call to "rec" because comments @@ -182,7 +173,6 @@ (-> Text (R;Result XML)) (l;run input xml^)) -## [Generation] (def: (sanitize-value input) (-> Text Text) (|> input @@ -231,7 +221,6 @@ (text;join-with "")) "</" tag ">"))))))) -## [Structs] (struct: #export _ (Codec Text XML) (def: encode write) (def: decode read)) @@ -244,7 +233,7 @@ [(#Node reference/tag reference/attrs reference/children) (#Node sample/tag sample/attrs sample/children)] - (and (Ident/= reference/tag sample/tag) + (and (ident/= reference/tag sample/tag) (:: (d;Eq<Dict> text;Eq<Text>) = reference/attrs sample/attrs) (n.= (list;size reference/children) (list;size sample/children)) @@ -253,3 +242,108 @@ _ false))) + +(type: #export (Reader a) + (p;Parser (List XML) a)) + +(exception: #export Empty-Input) +(exception: #export Unexpected-Input) +(exception: #export Unknown-Attribute) +(exception: #export Wrong-Tag) +(exception: #export Unconsumed-Inputs) + +(def: #export text + (Reader Text) + (function [docs] + (case docs + #;Nil + (ex;throw Empty-Input "") + + (#;Cons head tail) + (case head + (#Text value) + (#R;Success [tail value]) + + (#Node _) + (ex;throw Unexpected-Input ""))))) + +(def: #export (attr name) + (-> Ident (Reader Text)) + (function [docs] + (case docs + #;Nil + (ex;throw Empty-Input "") + + (#;Cons head _) + (case head + (#Text _) + (ex;throw Unexpected-Input "") + + (#Node tag attrs children) + (case (d;get name attrs) + #;None + (ex;throw Unknown-Attribute "") + + (#;Some value) + (#R;Success [docs value])))))) + +(def: (run' docs reader) + (All [a] (-> (List XML) (Reader a) (R;Result a))) + (case (p;run docs reader) + (#R;Success [remaining output]) + (if (list;empty? remaining) + (#R;Success output) + (ex;throw Unconsumed-Inputs (|> remaining + (L/map (:: Codec<Text,XML> encode)) + (text;join-with "\n\n")))) + + (#R;Error error) + (#R;Error error))) + +(def: #export (node tag) + (-> Ident (Reader Unit)) + (function [docs] + (case docs + #;Nil + (ex;throw Empty-Input "") + + (#;Cons head _) + (case head + (#Text _) + (ex;throw Unexpected-Input "") + + (#Node _tag _attrs _children) + (if (ident/= tag _tag) + (#R;Success [docs []]) + (ex;throw Wrong-Tag (ident/encode tag))))))) + +(def: #export (children reader) + (All [a] (-> (Reader a) (Reader a))) + (function [docs] + (case docs + #;Nil + (ex;throw Empty-Input "") + + (#;Cons head tail) + (case head + (#Text _) + (ex;throw Unexpected-Input "") + + (#Node _tag _attrs _children) + (do R;Monad<Result> + [output (run' _children reader)] + (wrap [tail output])))))) + +(def: #export ignore + (Reader Unit) + (function [docs] + (case docs + #;Nil + (ex;throw Empty-Input "") + + (#;Cons head tail) + (#R;Success [tail []])))) + +(def: #export (run document reader) + (All [a] (-> XML (Reader a) (R;Result a))) + (run' (list document) reader)) diff --git a/stdlib/source/lux/math.lux b/stdlib/source/lux/math.lux index 73c37d598..c2933ba85 100644 --- a/stdlib/source/lux/math.lux +++ b/stdlib/source/lux/math.lux @@ -99,45 +99,48 @@ (type: #rec Infix (#Const Code) (#Call (List Code)) - (#Infix Infix Code Infix)) - -(def: (infix^ _) - (-> Unit (Syntax Infix)) - ($_ p;alt - ($_ p;either - (p/map code;bool s;bool) - (p/map code;nat s;nat) - (p/map code;int s;int) - (p/map code;deg s;deg) - (p/map code;frac s;frac) - (p/map code;text s;text) - (p/map code;symbol s;symbol) - (p/map code;tag s;tag)) - (s;form (p;many s;any)) - (s;tuple (p;either (do p;Monad<Parser> - [_ (s;this (' #and)) - init-subject (infix^ []) - init-op s;any - init-param (infix^ []) - steps (p;some (p;seq s;any (infix^ [])))] - (wrap (product;right (L/fold (function [[op param] [subject [_subject _op _param]]] - [param [(#Infix _subject _op _param) - (` and) - (#Infix subject op param)]]) - [init-param [init-subject init-op init-param]] - steps)))) - (do p;Monad<Parser> - [_ (wrap []) - init-subject (infix^ []) - init-op s;any - init-param (infix^ []) - steps (p;some (p;seq s;any (infix^ [])))] - (wrap (L/fold (function [[op param] [_subject _op _param]] - [(#Infix _subject _op _param) op param]) - [init-subject init-op init-param] - steps))) - )) - )) + (#Unary Code Infix) + (#Binary Infix Code Infix)) + +(def: infix^ + (Syntax Infix) + (<| p;rec (function [infix^]) + ($_ p;alt + ($_ p;either + (p/map code;bool s;bool) + (p/map code;nat s;nat) + (p/map code;int s;int) + (p/map code;deg s;deg) + (p/map code;frac s;frac) + (p/map code;text s;text) + (p/map code;symbol s;symbol) + (p/map code;tag s;tag)) + (s;form (p;many s;any)) + (s;tuple (p;seq s;any infix^)) + (s;tuple ($_ p;either + (do p;Monad<Parser> + [_ (s;this (' #and)) + init-subject infix^ + init-op s;any + init-param infix^ + steps (p;some (p;seq s;any infix^))] + (wrap (product;right (L/fold (function [[op param] [subject [_subject _op _param]]] + [param [(#Binary _subject _op _param) + (` and) + (#Binary subject op param)]]) + [init-param [init-subject init-op init-param]] + steps)))) + (do p;Monad<Parser> + [init-subject infix^ + init-op s;any + init-param infix^ + steps (p;some (p;seq s;any infix^))] + (wrap (L/fold (function [[op param] [_subject _op _param]] + [(#Binary _subject _op _param) op param]) + [init-subject init-op init-param] + steps))) + )) + ))) (def: (infix-to-prefix infix) (-> Infix Code) @@ -147,15 +150,19 @@ (#Call parts) (code;form parts) + + (#Unary op subject) + (` ((~ op) (~ (infix-to-prefix subject)))) - (#Infix left op right) + (#Binary left op right) (` ((~ op) (~ (infix-to-prefix right)) (~ (infix-to-prefix left)))) )) -(syntax: #export (infix [expr (infix^ [])]) +(syntax: #export (infix [expr infix^]) {#;doc (doc "Infix math syntax." (infix [x i.* 10]) (infix [[x i.+ y] i.* [x i.- y]]) + (infix [sin [x i.+ y]]) (infix [[x n.< y] and [y n.< z]]) (infix [#and x n.< y n.< z]) (infix [(n.* +3 +9) gcd +450]) diff --git a/stdlib/test/test/lux/data/coll/tree/zipper.lux b/stdlib/test/test/lux/data/coll/tree/zipper.lux index b7936b140..9154459b9 100644 --- a/stdlib/test/test/lux/data/coll/tree/zipper.lux +++ b/stdlib/test/test/lux/data/coll/tree/zipper.lux @@ -3,23 +3,23 @@ (lux [io] (control [monad #+ do Monad] pipe) - (data (coll [list "List/" Fold<List> Functor<List>] + (data (coll [list "L/" Fold<List> Functor<List>] (tree ["&" zipper] [rose])) - [text "Text/" Monoid<Text>] + [text] text/format [number]) - ["R" math/random]) + ["r" math/random]) lux/test) (def: gen-tree - (R;Random (rose;Tree Nat)) - (R;rec (function [gen-tree] - (do R;Monad<Random> + (r;Random (rose;Tree Nat)) + (r;rec (function [gen-tree] + (do r;Monad<Random> ## Each branch can have, at most, 1 child. - [size (|> R;nat (:: @ map (n.% +2)))] - (R;seq R;nat - (R;list size gen-tree)))))) + [size (|> r;nat (:: @ map (n.% +2)))] + (r;seq r;nat + (r;list size gen-tree)))))) (def: (to-end zipper) (All [a] (-> (&;Zipper a) (&;Zipper a))) @@ -28,35 +28,34 @@ zipper (recur (&;next zipper))))) -(context: "Zippers" +(context: "Zippers." [sample gen-tree - new-val R;nat - pre-val R;nat - post-val R;nat - #let [(^open "Tree/") (rose;Eq<Tree> number;Eq<Nat>) - (^open "List/") (list;Eq<List> number;Eq<Nat>)]] + new-val r;nat + pre-val r;nat + post-val r;nat + #let [(^open "tree/") (rose;Eq<Tree> number;Eq<Nat>) + (^open "L/") (list;Eq<List> number;Eq<Nat>)]] ($_ seq (test "Trees can be converted to/from zippers." (|> sample - &;from-tree &;to-tree - (Tree/= sample))) + &;zip &;unzip + (tree/= sample))) (test "Creating a zipper gives you a root node." - (|> sample &;from-tree &;root?)) + (|> sample &;zip &;root?)) (test "Can move down inside branches. Can move up from lower nodes." - (let [zipper (&;from-tree sample)] + (let [zipper (&;zip sample)] (if (&;branch? zipper) (let [child (|> zipper &;down)] - (and (not (Tree/= sample (&;to-tree child))) - (|> child &;parent (default (undefined)) (is zipper)) + (and (not (tree/= sample (&;unzip child))) (|> child &;up (is zipper) not) (|> child &;root (is zipper) not))) (and (&;leaf? zipper) (|> zipper (&;prepend-child new-val) &;branch?))))) (test "Can prepend and append children." - (let [zipper (&;from-tree sample)] + (let [zipper (&;zip sample)] (if (&;branch? zipper) (let [mid-val (|> zipper &;down &;value) zipper (|> zipper @@ -71,7 +70,7 @@ true))) (test "Can insert children around a node (unless it's root)." - (let [zipper (&;from-tree sample)] + (let [zipper (&;zip sample)] (if (&;branch? zipper) (let [mid-val (|> zipper &;down &;value) zipper (|> zipper @@ -93,26 +92,26 @@ #;None true)))))) (test "Can set and update the value of a node." - (|> sample &;from-tree (&;set new-val) &;value (n.= new-val))) + (|> sample &;zip (&;set new-val) &;value (n.= new-val))) (test "Zipper traversal follows the outline of the tree depth-first." - (List/= (rose;flatten sample) - (loop [zipper (&;from-tree sample)] - (if (&;end? zipper) - (list (&;value zipper)) - (#;Cons (&;value zipper) - (recur (&;next zipper))))))) + (L/= (rose;flatten sample) + (loop [zipper (&;zip sample)] + (if (&;end? zipper) + (list (&;value zipper)) + (#;Cons (&;value zipper) + (recur (&;next zipper))))))) (test "Backwards zipper traversal yield reverse tree flatten." - (List/= (list;reverse (rose;flatten sample)) - (loop [zipper (to-end (&;from-tree sample))] - (if (&;root? zipper) - (list (&;value zipper)) - (#;Cons (&;value zipper) - (recur (&;prev zipper))))))) + (L/= (list;reverse (rose;flatten sample)) + (loop [zipper (to-end (&;zip sample))] + (if (&;root? zipper) + (list (&;value zipper)) + (#;Cons (&;value zipper) + (recur (&;prev zipper))))))) (test "Can remove nodes (except root nodes)." - (let [zipper (&;from-tree sample)] + (let [zipper (&;zip sample)] (if (&;branch? zipper) (and (|> zipper &;down &;root? not) (|> zipper &;down &;remove (case> #;None false diff --git a/stdlib/test/test/lux/data/format/xml.lux b/stdlib/test/test/lux/data/format/xml.lux index 1910caf3e..382659ab0 100644 --- a/stdlib/test/test/lux/data/format/xml.lux +++ b/stdlib/test/test/lux/data/format/xml.lux @@ -2,13 +2,15 @@ lux (lux [io] (control [monad #+ do Monad] + ["p" parser] pipe) - (data [text "Text/" Monoid<Text>] + (data [text "text/" Eq<Text>] text/format [ident] + ["R" result] (format ["&" xml]) (coll [dict] - [list])) + [list "L/" Functor<List>])) ["r" math/random "r/" Monad<Random>] test) ) @@ -52,7 +54,7 @@ (r;dict ident;Hash<Ident> size xml-identifier^ (xml-text^ +0 +10)) (r;list size gen-xml))))))) -(context: "XML" +(context: "XML." [sample gen-xml #let [(^open "&/") &;Eq<XML> (^open "&/") &;Codec<Text,XML>]] @@ -68,3 +70,44 @@ (#;Left error) false))) )) + +(context: "Parsing." + [text (xml-text^ +1 +10) + num-children (|> r;nat (:: @ map (n.% +5))) + children (r;list num-children (xml-text^ +1 +10)) + tag xml-identifier^ + attr xml-identifier^ + value (xml-text^ +1 +10) + #let [node (#&;Node tag + (dict;put attr value &;attrs) + (L/map (|>. #&;Text) children))]] + ($_ seq + (test "Can parse text." + (R;default false + (do R;Monad<Result> + [output (&;run (#&;Text text) + &;text)] + (wrap (text/= text output))))) + (test "Can parse attributes." + (R;default false + (do R;Monad<Result> + [output (|> (&;attr attr) + (p;before &;ignore) + (&;run node))] + (wrap (text/= value output))))) + (test "Can parse nodes." + (R;default false + (do R;Monad<Result> + [_ (|> (&;node tag) + (p;before &;ignore) + (&;run node))] + (wrap true)))) + (test "Can parse children." + (R;default false + (do R;Monad<Result> + [outputs (|> (&;children (p;some &;text)) + (&;run node))] + (wrap (:: (list;Eq<List> text;Eq<Text>) = + children + outputs))))) + )) diff --git a/stdlib/test/test/lux/math.lux b/stdlib/test/test/lux/math.lux index 63a449965..701790886 100644 --- a/stdlib/test/test/lux/math.lux +++ b/stdlib/test/test/lux/math.lux @@ -8,7 +8,7 @@ [number "f/" Number<Frac>] (coll [list "List/" Fold<List> Functor<List>]) [product]) - ["R" math/random] + ["r" math/random] ["&" math]) lux/test) @@ -23,7 +23,7 @@ ## ## I won't be testing this, until I can figure out what's going on, or ## ## come up with my own implementation ## (context: "Trigonometry" -## [angle (|> R;frac (:: @ map (f.* &;tau)))] +## [angle (|> r;frac (:: @ map (f.* &;tau)))] ## ($_ seq ## (test "Sine and arc-sine are inverse functions." ## (|> angle &;sin &;asin (within? margin angle))) @@ -36,11 +36,11 @@ ## )) (context: "Roots" - [factor (|> R;nat (:: @ map (|>. (n.% +1000) + [factor (|> r;nat (:: @ map (|>. (n.% +1000) (n.max +1) nat-to-int int-to-frac))) - base (|> R;frac (:: @ map (f.* factor)))] + base (|> r;frac (:: @ map (f.* factor)))] ($_ seq (test "Square-root is inverse of square." (|> base (&;pow 2.0) &;root2 (f.= base))) @@ -50,7 +50,7 @@ )) (context: "Rounding" - [sample (|> R;frac (:: @ map (f.* 1000.0)))] + [sample (|> r;frac (:: @ map (f.* 1000.0)))] ($_ seq (test "The ceiling will be an integer value, and will be >= the original." (let [ceil'd (&;ceil sample)] @@ -71,12 +71,12 @@ )) (context: "Exponentials and logarithms" - [sample (|> R;frac (:: @ map (f.* 10.0)))] + [sample (|> r;frac (:: @ map (f.* 10.0)))] (test "Logarithm is the inverse of exponential." (|> sample &;exp &;log (within? 1.0e-15 sample)))) (context: "Greatest-Common-Divisor and Least-Common-Multiple" - [#let [gen-nat (|> R;nat (:: @ map (|>. (n.% +1000) (n.max +1))))] + [#let [gen-nat (|> r;nat (:: @ map (|>. (n.% +1000) (n.max +1))))] x gen-nat y gen-nat] ($_ (test "GCD" @@ -93,17 +93,24 @@ )) (context: "Infix syntax" - [x R;nat - y R;nat - z R;nat + [x r;nat + y r;nat + z r;nat + theta r;frac #let [top (|> x (n.max y) (n.max z)) bottom (|> x (n.min y) (n.min z))]] ($_ seq (test "Constant values don't change." - (n.= x (&;infix x))) + (n.= x + (&;infix x))) - (test "Can call infix functions." - (n.= (&;gcd y x) (&;infix [x &;gcd y]))) + (test "Can call binary functions." + (n.= (&;gcd y x) + (&;infix [x &;gcd y]))) + + (test "Can call unary functions." + (f.= (&;sin theta) + (&;infix [&;sin theta]))) (test "Can use regular syntax in the middle of infix code." (n.= (&;gcd +450 (n.* +3 +9)) diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux index 598c488fd..62683aea5 100644 --- a/stdlib/test/tests.lux +++ b/stdlib/test/tests.lux @@ -52,10 +52,10 @@ ["_;" seq] ["_;" priority-queue] ["_;" stream] - (tree ["_;" rose] - ["_;" zipper]) - (ordered ["_o;" dict] - ["_o;" set])) + (tree ["tree_;" rose] + ["tree_;" zipper]) + (ordered ["ordered_;" dict] + ["ordered_;" set])) (text ["_;" format] ["_;" lexer] ["_;" regex])) @@ -85,7 +85,8 @@ [tainted] (format [context] [html] - [css])) + [css]) + (coll (tree ["tree_;" parser]))) [macro] (math [random]) (type [unit]) |