From 15e71e57b688f5079fe606b2fee5e3efd2a5d5a7 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 28 Jul 2018 14:55:30 -0400 Subject: Added "+" sign to positive Int. --- stdlib/source/lux.lux | 90 +++++++++++++++++++++++++-------------------------- 1 file changed, 45 insertions(+), 45 deletions(-) (limited to 'stdlib/source/lux.lux') diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index a30c03a78..dd5a42064 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -1029,7 +1029,7 @@ (#Cons [(tag$ ["lux" "doc"]) (text$ "## Throws away any code given to it. ## Great for commenting-out code, while retaining syntax high-lighting and formatting in your text editor. - (comment 1 2 3 4)")] + (comment +1 +2 +3 +4)")] #Nil) (return #Nil)) @@ -1338,7 +1338,7 @@ (macro:' #export (list xs) (#Cons [(tag$ ["lux" "doc"]) (text$ "## List-construction macro. - (list 1 2 3)")] + (list +1 +2 +3)")] #Nil) (return (#Cons (list/fold (function'' [head tail] (form$ (#Cons (tag$ ["lux" "Cons"]) @@ -1352,7 +1352,7 @@ (#Cons [(tag$ ["lux" "doc"]) (text$ "## List-construction macro, with the last element being a tail-list. ## In other words, this macro prepends elements to another list. - (list& 1 2 3 (list 4 5 6))")] + (list& +1 +2 +3 (list +4 +5 +6))")] #Nil) ({(#Cons last init) (return (list (list/fold (function'' [head tail] @@ -2257,7 +2257,7 @@ (-> Int Int) (i/+ ))] - [inc 1] + [inc +1] [dec -1])")]) ({(#Cons [[_ (#Tuple bindings)] (#Cons [[_ (#Tuple templates)] data])]) ({[(#Some bindings') (#Some data')] @@ -2364,7 +2364,7 @@ (list [(tag$ ["lux" "doc"]) (text$ "Nat(ural) division.")]) (-> Nat Nat Nat) - (if ("lux int <" ("lux coerce" Int param) 0) + (if ("lux int <" ("lux coerce" Int param) +0) (if (n/< param subject) |0 |1) @@ -2469,11 +2469,11 @@ (list [(tag$ ["lux" "doc"]) (text$ "Rev(olution) division.")]) (-> Rev Rev Rev) - (if ("lux i64 =" 0 param) + (if ("lux i64 =" +0 param) ("lux io error" "Cannot divide Rev by zero!") (let' [[trailing-zeroes remaining] (without-trailing-zeroes |0 ("lux coerce" Nat param)) [trailing-zeroes denominator] ("lux check" (#Product Nat Nat) - (if ("lux i64 =" 0 trailing-zeroes) + (if ("lux i64 =" +0 trailing-zeroes) [|1 ("lux i64 logical-right-shift" |1 remaining)] [trailing-zeroes remaining])) shift ("lux i64 -" trailing-zeroes |64) @@ -2560,7 +2560,7 @@ (let' [loop ("lux check" (-> Nat Text Text) (function' recur [input output] (if (n/= |0 input) - (text/compose "+" output) + (text/compose "|" output) (recur (n// |10 input) (text/compose (|> input (n/% |10) digit-to-text) output)))))] @@ -2570,27 +2570,27 @@ (def:''' (int/abs value) #Nil (-> Int Int) - (if (i/< 0 value) + (if (i/< +0 value) (i/* -1 value) value)) (def:''' (int/encode value) #Nil (-> Int Text) - (if (i/= 0 value) + (if (i/= +0 value) "0" - (let' [sign (if (i/> 0 value) + (let' [sign (if (i/> +0 value) "" "-")] (("lux check" (-> Int Text Text) (function' recur [input output] - (if (i/= 0 input) + (if (i/= +0 input) (text/compose sign output) - (recur (i// 10 input) - (text/compose (|> input (i/% 10) ("lux coerce" Nat) digit-to-text) + (recur (i// +10 input) + (text/compose (|> input (i/% +10) ("lux coerce" Nat) digit-to-text) output))))) - (|> value (i// 10) int/abs) - (|> value (i/% 10) int/abs ("lux coerce" Nat) digit-to-text))))) + (|> value (i// +10) int/abs) + (|> value (i/% +10) int/abs ("lux coerce" Nat) digit-to-text))))) (def:''' (frac/encode x) #Nil @@ -2836,7 +2836,7 @@ (macro:' #export (: tokens) (list [(tag$ ["lux" "doc"]) (text$ "## The type-annotation macro. - (: (List Int) (list 1 2 3))")]) + (: (List Int) (list +1 +2 +3))")]) ({(#Cons type (#Cons value #Nil)) (return (list (` ("lux check" (type (~ type)) (~ value))))) @@ -2847,7 +2847,7 @@ (macro:' #export (:coerce tokens) (list [(tag$ ["lux" "doc"]) (text$ "## The type-coercion macro. - (:coerce Dinosaur (list 1 2 3))")]) + (:coerce Dinosaur (list +1 +2 +3))")]) ({(#Cons type (#Cons value #Nil)) (return (list (` ("lux coerce" (type (~ type)) (~ value))))) @@ -3117,7 +3117,7 @@ (list [(tag$ ["lux" "doc"]) (text$ "## The pattern-matching macro. ## Allows the usage of macros within the patterns to provide custom syntax. - (case (: (List Int) (list 1 2 3)) + (case (: (List Int) (list +1 +2 +3)) (#Cons x (#Cons y (#Cons z #Nil))) (#Some ($_ i/* x y z)) @@ -3136,7 +3136,7 @@ (list [(tag$ ["lux" "doc"]) (text$ "## Macro-expanding patterns. ## It's a special macro meant to be used with 'case'. - (case (: (List Int) (list 1 2 3)) + (case (: (List Int) (list +1 +2 +3)) (^ (list x y z)) (#Some ($_ i/* x y z)) @@ -3353,7 +3353,7 @@ (def: branching-exponent Int - 5)")]) + +5)")]) (let [[export? tokens'] (export^ tokens) parts (: (Maybe [Code (List Code) (Maybe Code) Code (List [Code Code])]) (case tokens' @@ -3610,9 +3610,9 @@ (macro: (default tokens state) {#.doc "## Allows you to provide a default value that will be used ## if a (Maybe x) value turns out to be #.None. - (default 20 (#.Some 10)) => 10 + (default +20 (#.Some +10)) => +10 - (default 20 #.None) => 20"} + (default +20 #.None) => +20"} (case tokens (^ (list else maybe)) (let [g!temp (: Code [dummy-cursor (#Identifier ["" ""])]) @@ -4872,7 +4872,7 @@ (:: Codec encode) ## Also allows using that value as a function. - (:: Codec encode 123)"} + (:: Codec encode +123)"} (case tokens (^ (list struct [_ (#Identifier member)])) (return (list (` (let [(^open ".") (~ struct)] (~ (identifier$ member)))))) @@ -5199,7 +5199,7 @@ (def: (repeat n x) (All [a] (-> Int a (List a))) - (if (i/> 0 n) + (if (i/> +0 n) (#Cons x (repeat (i/+ -1 n) x)) #Nil)) @@ -5289,9 +5289,9 @@ ## For Example: (doc \"Allows arbitrary looping, using the \\\"recur\\\" form to re-start the loop. Can be used in monadic code to create monadic loops.\" - (loop [count 0 + (loop [count +0 x init] - (if (< 10 count) + (if (< +10 count) (recur (inc count) (f x)) x)))"} (return (list (` [(~ cursor-code) @@ -5354,17 +5354,17 @@ (macro: #export (loop tokens) {#.doc (doc "Allows arbitrary looping, using the \"recur\" form to re-start the loop." "Can be used in monadic code to create monadic loops." - (loop [count 0 + (loop [count +0 x init] - (if (< 10 count) + (if (< +10 count) (recur (inc count) (f x)) x)) "Loops can also be given custom names." (loop my-loop - [count 0 + [count +0 x init] - (if (< 10 count) + (if (< +10 count) (my-loop (inc count) (f x)) x)))} (let [?params (case tokens @@ -5497,14 +5497,14 @@ [(bit #1) "#1" [_ (#.Bit #1)]] [(bit #0) "#0" [_ (#.Bit #0)]] - [(int 123) "123" [_ (#.Int 123)]] - [(frac 123.0) "123.0" [_ (#.Frac 123.0)]] + [(int +123) "+123" [_ (#.Int +123)]] + [(frac +123.0) "+123.0" [_ (#.Frac +123.0)]] [(text "\n") "\"\\n\"" [_ (#.Text "\n")]] [(tag ["yolo" "lol"]) "#yolo.lol" [_ (#.Tag ["yolo" "lol"])]] [(identifier ["yolo" "lol"]) "yolo.lol" [_ (#.Identifier ["yolo" "lol"])]] - [(form (list (bit #1) (int 123))) "(#1 123)" (^ [_ (#.Form (list [_ (#.Bit #1)] [_ (#.Int 123)]))])] - [(tuple (list (bit #1) (int 123))) "[#1 123]" (^ [_ (#.Tuple (list [_ (#.Bit #1)] [_ (#.Int 123)]))])] - [(record (list [(bit #1) (int 123)])) "{#1 123}" (^ [_ (#.Record (list [[_ (#.Bit #1)] [_ (#.Int 123)]]))])] + [(form (list (bit #1) (int +123))) "(#1 +123)" (^ [_ (#.Form (list [_ (#.Bit #1)] [_ (#.Int +123)]))])] + [(tuple (list (bit #1) (int +123))) "[#1 +123]" (^ [_ (#.Tuple (list [_ (#.Bit #1)] [_ (#.Int +123)]))])] + [(record (list [(bit #1) (int +123)])) "{#1 +123}" (^ [_ (#.Record (list [[_ (#.Bit #1)] [_ (#.Int +123)]]))])] [(local-tag "lol") "#lol" [_ (#.Tag ["" "lol"])]] [(local-identifier "lol") "lol" [_ (#.Identifier ["" "lol"])]] )] @@ -5716,7 +5716,7 @@ (not ( n)))] [Nat n/even? n/odd? n/% n/= |0 |2] - [Int i/even? i/odd? i/% i/= 0 2]) + [Int i/even? i/odd? i/% i/= +0 +2]) (def: (get-scope-type-vars state) (Meta (List Nat)) @@ -5765,11 +5765,11 @@ (def: #export (is? reference sample) {#.doc (doc "Tests whether the 2 values are identical (not just \"equal\")." "This one should succeed:" - (let [value 5] + (let [value +5] (is? value value)) "This one should fail:" - (is? 5 (i/+ 2 3)))} + (is? +5 (i/+ +2 +3)))} (All [a] (-> a a Bit)) ("lux is" reference sample)) @@ -5807,7 +5807,7 @@ (macro: #export (:assume tokens) {#.doc (doc "Coerces the given expression to the type of whatever is expected." - (: Dinosaur (:assume (list 1 2 3))))} + (: Dinosaur (:assume (list +1 +2 +3))))} (case tokens (^ (list expr)) (do Monad @@ -5833,7 +5833,7 @@ (macro: #export (:of tokens) {#.doc (doc "Generates the type corresponding to a given definition or variable." - (let [my-num (: Int 123)] + (let [my-num (: Int +123)] (:of my-num)) "==" Int)} @@ -6152,8 +6152,8 @@ (def: #export (i/mod param subject) (All [m] (-> Int Int Int)) (let [raw (i/% param subject)] - (if (i/< 0 raw) - (let [shift (if (i/< 0 param) i/- i/+)] + (if (i/< +0 raw) + (let [shift (if (i/< +0 param) i/- i/+)] (|> raw (shift param))) raw))) @@ -6177,11 +6177,11 @@ (def: #export (frac-to-rev input) (-> Frac Rev) - (let [abs (if (f/< 0.0 input) + (let [abs (if (f/< +0.0 input) (f/* -1.0 input) input)] (|> abs - (f/% 1.0) + (f/% +1.0) (f/* rev-denominator) frac-to-int ("lux i64 left-shift" |11)))) -- cgit v1.2.3