diff options
author | Eduardo Julian | 2018-05-13 00:47:43 -0400 |
---|---|---|
committer | Eduardo Julian | 2018-05-13 00:47:43 -0400 |
commit | 38742d7c110f5a28f9ea4aec117cc531ac6c9b5e (patch) | |
tree | 47e75d21064c216e6156f68764b94fc86526633f /stdlib/source/lux.lux | |
parent | 6717fc5e4aaf5986cd4f0d4ea1a12793188cbe9a (diff) |
- Added new #I64 type as foundation for types based on 64-bit integers.
Diffstat (limited to '')
-rw-r--r-- | stdlib/source/lux.lux | 328 |
1 files changed, 145 insertions, 183 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index 4c52bf00f..795133b33 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -1,8 +1,8 @@ ## Basic types ("lux def" dummy-cursor ("lux check" (+2 (+0 "#Text" (+0)) - (+2 (+0 "#Nat" (+0)) - (+0 "#Nat" (+0)))) + (+2 (+0 "#I64" (+1 (+0 "#Nat" (+0)) (+0))) + (+0 "#I64" (+1 (+0 "#Nat" (+0)) (+0))))) ["" +0 +0]) [["" +0 +0] (+10 (+1 [[["" +0 +0] (+7 ["lux" "export?"])] @@ -22,7 +22,7 @@ (+1 [[dummy-cursor (+7 ["lux" "doc"])] [dummy-cursor (+5 "The type of things whose type does not matter. - It can be used to write functions or data-structures that can take, or return, anything.")]] + It can be used to write functions or data-structures that can take, or return, anything.")]] (+0)))))]) ## (type: Bottom @@ -38,7 +38,7 @@ (+1 [[dummy-cursor (+7 ["lux" "doc"])] [dummy-cursor (+5 "The type of things whose type is unknown or undefined. - Useful for expressions that cause errors or other \"extraordinary\" conditions.")]] + Useful for expressions that cause errors or other \"extraordinary\" conditions.")]] (+0)))))]) ## (type: (List a) @@ -77,9 +77,22 @@ [dummy-cursor (+5 "Your standard, run-of-the-mill boolean values.")]] #Nil))))]) +("lux def" I64 + (+10 ["lux" "I64"] + (+7 (+0) + (+0 "#I64" (#Cons (+4 +1) #Nil)))) + [dummy-cursor + (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "export?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "doc"])] + [dummy-cursor (+5 "64-bit integers without any semantics.")]] + #Nil))))]) + ("lux def" Nat (+10 ["lux" "Nat"] - (+0 "#Nat" #Nil)) + (+0 "#I64" (#Cons (+0 "#Nat" #Nil) #Nil))) [dummy-cursor (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] [dummy-cursor (+0 true)]] @@ -88,12 +101,12 @@ (#Cons [[dummy-cursor (+7 ["lux" "doc"])] [dummy-cursor (+5 "Natural numbers (unsigned integers). - They start at zero (+0) and extend in the positive direction.")]] + They start at zero (+0) and extend in the positive direction.")]] #Nil))))]) ("lux def" Int (+10 ["lux" "Int"] - (+0 "#Int" #Nil)) + (+0 "#I64" (#Cons (+0 "#Int" #Nil) #Nil))) [dummy-cursor (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] [dummy-cursor (+0 true)]] @@ -103,30 +116,30 @@ [dummy-cursor (+5 "Your standard, run-of-the-mill integer numbers.")]] #Nil))))]) -("lux def" Frac - (+10 ["lux" "Frac"] - (+0 "#Frac" #Nil)) +("lux def" Deg + (+10 ["lux" "Deg"] + (+0 "#I64" (#Cons (+0 "#Deg" #Nil) #Nil))) [dummy-cursor (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] [dummy-cursor (+0 true)]] (#Cons [[dummy-cursor (+7 ["lux" "export?"])] [dummy-cursor (+0 true)]] (#Cons [[dummy-cursor (+7 ["lux" "doc"])] - [dummy-cursor (+5 "Your standard, run-of-the-mill floating-point (fractional) numbers.")]] + [dummy-cursor (+5 "Fractional numbers that live in the interval [0,1). + + Useful for probability, and other domains that work within that interval.")]] #Nil))))]) -("lux def" Deg - (+10 ["lux" "Deg"] - (+0 "#Deg" #Nil)) +("lux def" Frac + (+10 ["lux" "Frac"] + (+0 "#Frac" #Nil)) [dummy-cursor (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] [dummy-cursor (+0 true)]] (#Cons [[dummy-cursor (+7 ["lux" "export?"])] [dummy-cursor (+0 true)]] (#Cons [[dummy-cursor (+7 ["lux" "doc"])] - [dummy-cursor (+5 "Fractional numbers that live in the interval [0,1). - - Useful for probability, and other domains that work within that interval.")]] + [dummy-cursor (+5 "Your standard, run-of-the-mill floating-point (fractional) numbers.")]] #Nil))))]) ("lux def" Text @@ -152,7 +165,7 @@ (#Cons [[dummy-cursor (+7 ["lux" "doc"])] [dummy-cursor (+5 "An identifier. - It is used as part of Lux syntax to represent symbols and tags.")]] + It is used as part of Lux syntax to represent symbols and tags.")]] #Nil))))]) ## (type: (Maybe a) @@ -1119,20 +1132,14 @@ (#.Cons export-meta #.Nil)) (#Function Nat (#Function Nat Nat)) - ("lux coerce" Nat - ("lux int +" - ("lux coerce" Int subject) - ("lux coerce" Int param)))) + ("lux i64 +" param subject)) (def:'' (n/- param subject) (#.Cons (doc-meta "Nat(ural) substraction.") (#.Cons export-meta #.Nil)) (#Function Nat (#Function Nat Nat)) - ("lux coerce" Nat - ("lux int -" - ("lux coerce" Int subject) - ("lux coerce" Int param)))) + ("lux i64 -" param subject)) (def:'' (n/* param subject) (#.Cons (doc-meta "Nat(ural) multiplication.") @@ -2201,28 +2208,24 @@ (list [(tag$ ["lux" "doc"]) (text$ "Nat(ural) equality.")]) (-> Nat Nat Bool) - ("lux int =" - ("lux coerce" Int subject) - ("lux coerce" Int test))) + ("lux i64 =" test subject)) (def:''' (high-bits value) (list) - (-> Nat Int) - ("lux coerce" Int ("lux bit logical-right-shift" value +32))) + (-> ($' I64 Top) I64) + ("lux i64 logical-right-shift" +32 value)) (def:''' low-mask (list) - Nat - ("lux coerce" Nat - ("lux int -" - ("lux coerce" Int - ("lux bit left-shift" +1 +32)) - 1))) + I64 + (|> +1 + ("lux i64 left-shift" +32) + ("lux i64 -" +1))) (def:''' (low-bits value) (list) - (-> Nat Int) - ("lux coerce" Int ("lux bit and" value low-mask))) + (-> ($' I64 Top) I64) + ("lux i64 and" low-mask value)) (def:''' #export (n/< test subject) (list [(tag$ ["lux" "doc"]) @@ -2232,7 +2235,7 @@ subjectH (high-bits subject)] (if ("lux int <" subjectH testH) true - (if ("lux int =" subjectH testH) + (if ("lux i64 =" testH subjectH) ("lux int <" (low-bits subject) (low-bits test)) @@ -2244,9 +2247,7 @@ (-> Nat Nat Bool) (if (n/< test subject) true - ("lux int =" - ("lux coerce" Int subject) - ("lux coerce" Int test)))) + ("lux i64 =" test subject))) (def:''' #export (n/> test subject) (list [(tag$ ["lux" "doc"]) @@ -2260,9 +2261,7 @@ (-> Nat Nat Bool) (if (n/< subject test) true - ("lux int =" - ("lux coerce" Int subject) - ("lux coerce" Int test)))) + ("lux i64 =" test subject))) (macro:' #export (do-template tokens) (list [(tag$ ["lux" "doc"]) @@ -2272,8 +2271,8 @@ (-> Int Int) (i/+ <diff>))] - [i/inc 1] - [i/dec -1])")]) + [inc 1] + [dec -1])")]) ("lux case" tokens {(#Cons [[_ (#Tuple bindings)] (#Cons [[_ (#Tuple templates)] data])]) ("lux case" [(monad/map Monad<Maybe> get-name bindings) @@ -2299,9 +2298,7 @@ (list [(tag$ ["lux" "doc"]) (text$ "Deg(ree) equality.")]) (-> Deg Deg Bool) - ("lux int =" - ("lux coerce" Int subject) - ("lux coerce" Int test))) + ("lux i64 =" test subject)) (def:''' #export (d/< test subject) (list [(tag$ ["lux" "doc"]) @@ -2317,9 +2314,7 @@ (if (n/< ("lux coerce" Nat test) ("lux coerce" Nat subject)) true - ("lux int =" - ("lux coerce" Int subject) - ("lux coerce" Int test)))) + ("lux i64 =" test subject))) (def:''' #export (d/> test subject) (list [(tag$ ["lux" "doc"]) @@ -2333,9 +2328,7 @@ (-> Deg Deg Bool) (if (d/< subject test) true - ("lux int =" - ("lux coerce" Int subject) - ("lux coerce" Int test)))) + ("lux i64 =" test subject))) (do-template [<type> <eq-proc> <lt-proc> <eq-name> <lt-name> <lte-name> <gt-name> <gte-name> @@ -2374,7 +2367,7 @@ true (<eq-proc> subject test)))] - [ Int "lux int =" "lux int <" i/= i/< i/<= i/> i/>= + [ Int "lux i64 =" "lux int <" i/= i/< i/<= i/> i/>= "Int(eger) equality." "Int(eger) less-than." "Int(eger) less-than-equal." "Int(eger) greater-than." "Int(eger) greater-than-equal."] [Frac "lux frac =" "lux frac <" f/= f/< f/<= f/> f/>= @@ -2389,27 +2382,18 @@ (if (n/< param subject) +0 +1) - (let' [quotient ("lux bit left-shift" - ("lux coerce" Nat - ("lux int /" - ("lux coerce" Int - ("lux bit logical-right-shift" - subject - +1)) - ("lux coerce" Int param))) - +1) - remainder ("lux coerce" Nat - ("lux int -" - ("lux coerce" Int subject) - ("lux int *" - ("lux coerce" Int quotient) - ("lux coerce" Int param))))] + (let' [quotient ("lux i64 left-shift" + +1 + ("lux int /" + ("lux i64 logical-right-shift" +1 subject) + ("lux coerce" Int param))) + flat ("lux int *" + ("lux coerce" Int quotient) + ("lux coerce" Int param)) + remainder ("lux i64 -" flat subject)] (if (n/< param remainder) quotient - ("lux coerce" Nat - ("lux int +" - ("lux coerce" Int quotient) - 1)))))) + ("lux i64 +" +1 quotient))))) (def:''' #export (n/% param subject) (list [(tag$ ["lux" "doc"]) @@ -2418,48 +2402,59 @@ (let' [flat ("lux int *" ("lux coerce" Int (n// param subject)) ("lux coerce" Int param))] - ("lux coerce" Nat - ("lux int -" - ("lux coerce" Int subject) - flat)))) + ("lux i64 -" flat subject))) (do-template [<type> <name> <op> <doc>] [(def:''' #export (<name> param subject) (list [(tag$ ["lux" "doc"]) (text$ <doc>)]) (-> <type> <type> <type>) - ("lux coerce" Deg - (<op> ("lux coerce" Int subject) - ("lux coerce" Int param))))] + (<op> param subject))] - [ Deg d/+ "lux int +" "Deg(ree) addition."] - [ Deg d/- "lux int -" "Deg(ree) substraction."] + [ Int i/+ "lux i64 +" "Int(eger) addition."] + [ Int i/- "lux i64 -" "Int(eger) substraction."] + + [ Deg d/+ "lux i64 +" "Deg(ree) addition."] + [ Deg d/- "lux i64 -" "Deg(ree) substraction."] + ) + +(do-template [<type> <name> <op> <doc>] + [(def:''' #export (<name> param subject) + (list [(tag$ ["lux" "doc"]) + (text$ <doc>)]) + (-> <type> <type> <type>) + (<op> subject param))] + + [ Int i/* "lux int *" "Int(eger) multiplication."] + [ Int i// "lux int /" "Int(eger) division."] + [ Int i/% "lux int %" "Int(eger) remainder."] + + [Frac f/+ "lux frac +" "Frac(tion) addition."] + [Frac f/- "lux frac -" "Frac(tion) substraction."] + [Frac f/* "lux frac *" "Frac(tion) multiplication."] + [Frac f// "lux frac /" "Frac(tion) division."] + [Frac f/% "lux frac %" "Frac(tion) remainder."] ) (def:''' #export (d/* param subject) (list [(tag$ ["lux" "doc"]) (text$ "Deg(ree) multiplication.")]) (-> Deg Deg Deg) - (let' [subjectH (high-bits ("lux coerce" Nat subject)) - subjectL (low-bits ("lux coerce" Nat subject)) - paramH (high-bits ("lux coerce" Nat param)) - paramL (low-bits ("lux coerce" Nat param)) - bottom ("lux coerce" Int - ("lux bit logical-right-shift" - ("lux coerce" Nat ("lux int *" subjectL paramL)) - +32)) - middle ("lux int +" + (let' [subjectH (high-bits subject) + subjectL (low-bits subject) + paramH (high-bits param) + paramL (low-bits param) + bottom (|> subjectL + ("lux int *" paramL) + ("lux i64 logical-right-shift" +32)) + middle ("lux i64 +" ("lux int *" subjectH paramL) ("lux int *" subjectL paramH)) top ("lux int *" subjectH paramH)] - ("lux coerce" Deg - ("lux int +" - (high-bits - ("lux coerce" Nat - ("lux int +" - bottom - middle))) - top)))) + (|> bottom + ("lux i64 +" middle) + high-bits + ("lux i64 +" top)))) (def:''' least-significant-bit-mask (list) Nat +1) @@ -2467,32 +2462,26 @@ (list) (-> Nat Nat (#Product Nat Nat)) (if (|> remaining - ("lux bit and" least-significant-bit-mask) - ("lux coerce" Int) - ("lux int =" 0)) + ("lux i64 and" least-significant-bit-mask) + ("lux i64 =" +0)) (without-trailing-zeroes - (|> count - ("lux coerce" Int) - ("lux int +" 1) - ("lux coerce" Nat)) - ("lux bit logical-right-shift" remaining +1)) + ("lux i64 +" +1 count) + ("lux i64 logical-right-shift" +1 remaining)) [count remaining])) (def:''' #export (d// param subject) (list [(tag$ ["lux" "doc"]) (text$ "Deg(ree) division.")]) (-> Deg Deg Deg) - (if (|> param ("lux coerce" Int) ("lux int =" 0)) + (if ("lux i64 =" 0 param) ("lux io error" "Cannot divide Deg by zero!") (let' [[trailing-zeroes remaining] (without-trailing-zeroes +0 ("lux coerce" Nat param)) - [trailing-zeroes denominator] (if (|> trailing-zeroes ("lux coerce" Int) ("lux int =" 0)) - [+1 ("lux bit logical-right-shift" remaining +1)] - [trailing-zeroes remaining]) - shift ("lux coerce" Nat - ("lux int -" - 64 - ("lux coerce" Int trailing-zeroes))) - numerator ("lux bit left-shift" +1 shift)] + [trailing-zeroes denominator] ("lux check" (#Product Nat Nat) + (if ("lux i64 =" 0 trailing-zeroes) + [+1 ("lux i64 logical-right-shift" +1 remaining)] + [trailing-zeroes remaining])) + shift ("lux i64 -" trailing-zeroes +64) + numerator ("lux i64 left-shift" shift +1)] ("lux coerce" Deg ("lux int *" ("lux coerce" Int subject) @@ -2508,26 +2497,6 @@ (n/% ("lux coerce" Nat subject) ("lux coerce" Nat param)))) -(do-template [<type> <name> <op> <doc>] - [(def:''' #export (<name> param subject) - (list [(tag$ ["lux" "doc"]) - (text$ <doc>)]) - (-> <type> <type> <type>) - (<op> subject param))] - - [ Int i/+ "lux int +" "Int(eger) addition."] - [ Int i/- "lux int -" "Int(eger) substraction."] - [ Int i/* "lux int *" "Int(eger) multiplication."] - [ Int i// "lux int /" "Int(eger) division."] - [ Int i/% "lux int %" "Int(eger) remainder."] - - [Frac f/+ "lux frac +" "Frac(tion) addition."] - [Frac f/- "lux frac -" "Frac(tion) substraction."] - [Frac f/* "lux frac *" "Frac(tion) multiplication."] - [Frac f// "lux frac /" "Frac(tion) division."] - [Frac f/% "lux frac %" "Frac(tion) remainder."] - ) - (def:''' #export (d/scale param subject) (list [(tag$ ["lux" "doc"]) (text$ "Deg(ree) scale.")]) @@ -2546,7 +2515,7 @@ (n// remaining ("lux case" trailing-zeroes {+0 ("lux coerce" Nat -1) - _ ("lux bit left-shift" +1 (n/- trailing-zeroes +64))}))))) + _ ("lux i64 left-shift" (n/- trailing-zeroes +64) +1)}))))) (do-template [<name> <type> <test> <doc>] [(def:''' #export (<name> left right) @@ -5117,7 +5086,7 @@ (macro: #export (update@ tokens) {#.doc "## Modifies the value of a record at a given tag, based on some function. - (update@ #age i/inc person) + (update@ #age inc person) ## Can also work with multiple levels of nesting: (update@ [#foo #bar #baz] func my-record) @@ -5256,8 +5225,8 @@ (-> <from> <to>) (<proc> [n]))] - [frac-to-int Frac Int "lux frac to-int"] - [int-to-frac Int Frac "lux int to-frac"] + [frac-to-int Frac Int "lux frac int"] + [int-to-frac Int Frac "lux int frac"] ) (def: (find-baseline-column code) @@ -5314,34 +5283,31 @@ )] ($_ text/compose "\"" escaped "\""))) -(do-template [<name> <op> <one> <type> <doc>] - [(def: #export (<name> value) +(do-template [<name> <special> <doc>] + [(def: #export <name> {#.doc <doc>} - (-> <type> <type>) - (<op> <one> value))] + (All [s] (-> (I64 s) (I64 s))) + (|>> (<special> +1)))] - [i/inc i/+ 1 Int "[Int] Increment function."] - [i/dec i/- 1 Int "[Int] Decrement function."] - [n/inc n/+ +1 Nat "[Nat] Increment function."] - [n/dec n/- +1 Nat "[Nat] Decrement function."] + [inc "lux i64 +" "Increment function."] + [dec "lux i64 -" "Decrement function."] ) (def: tag/encode (-> Ident Text) (|>> ident/encode (text/compose "#"))) -(do-template [<name> <from> <to>] +(do-template [<name> <to>] [(def: #export <name> - (-> <from> <to>) + (-> (I64 Top) <to>) (|>> (:! <to>)))] - [int-to-nat Int Nat] - [nat-to-int Nat Int] + [i64 I64] + [nat Nat] + [int Int] + [deg Deg] ) -(def: #export frac-to-nat (|>> frac-to-int int-to-nat)) -(def: #export nat-to-frac (|>> nat-to-int int-to-frac)) - (def: (repeat n x) (All [a] (-> Int a (List a))) (if (i/> 0 n) @@ -5351,9 +5317,9 @@ (def: (cursor-padding baseline [_ old-line old-column] [_ new-line new-column]) (-> Nat Cursor Cursor Text) (if (n/= old-line new-line) - (text/join (repeat (nat-to-int (n/- old-column new-column)) " ")) - (let [extra-lines (text/join (repeat (nat-to-int (n/- old-line new-line)) "\n")) - space-padding (text/join (repeat (nat-to-int (n/- baseline new-column)) " "))] + (text/join (repeat (.int (n/- old-column new-column)) " ")) + (let [extra-lines (text/join (repeat (.int (n/- old-line new-line)) "\n")) + space-padding (text/join (repeat (.int (n/- baseline new-column)) " "))] (text/compose extra-lines space-padding)))) (def: (text/size x) @@ -5366,7 +5332,7 @@ (def: (delim-update-cursor [file line column]) (-> Cursor Cursor) - [file line (n/inc column)]) + [file line (inc column)]) (def: rejoin-all-pairs (-> (List [Code Code]) (List Code)) @@ -5437,7 +5403,7 @@ (loop [count 0 x init] (if (< 10 count) - (recur (i/inc count) (f x)) + (recur (inc count) (f x)) x)))"} (return (list (` [(~ cursor-code) (#.Text (~ (|> tokens @@ -5502,7 +5468,7 @@ (loop [count 0 x init] (if (< 10 count) - (recur (i/inc count) (f x)) + (recur (inc count) (f x)) x)) "Loops can also be given custom names." @@ -5510,7 +5476,7 @@ [count 0 x init] (if (< 10 count) - (my-loop (i/inc count) (f x)) + (my-loop (inc count) (f x)) x)))} (let [?params (case tokens (^ (list name [_ (#Tuple bindings)] body)) @@ -5900,7 +5866,7 @@ (#Cons x xs') (if (n/= +0 idx) (#Some x) - (list-at (n/dec idx) xs')))) + (list-at (dec idx) xs')))) (macro: #export ($ tokens) {#.doc (doc "Allows you to refer to the type-variables in a polymorphic function's type, by their index." @@ -5955,7 +5921,7 @@ (macro: #export (^|> tokens) {#.doc (doc "Pipes the value being pattern-matched against prior to binding it to a variable." (case input - (^|> value [n/inc (n/% +10) (n/max +1)]) + (^|> value [inc (n/% +10) (n/max +1)]) (foo value)))} (case tokens (^ (list& [_meta (#Form (list [_ (#Symbol ["" name])] [_ (#Tuple steps)]))] body branches)) @@ -6330,31 +6296,27 @@ [Int i//% i// i/%] ) -(def: (to-significand value) - (-> Nat Frac) - (|> ("lux bit logical-right-shift" value +11) - (:! Int) - int-to-frac)) +(def: to-significand + (-> (I64 Top) Frac) + (|>> ("lux i64 logical-right-shift" +11) + int-to-frac)) -(def: deg-denominator Frac (to-significand (:! Nat -1))) +(def: deg-denominator Frac (to-significand -1)) (def: #export (frac-to-deg input) (-> Frac Deg) (let [abs (if (f/< 0.0 input) (f/* -1.0 input) input)] - (:! Deg - ("lux bit left-shift" - (|> abs - (f/% 1.0) - (f/* deg-denominator) - frac-to-int - (:! Nat)) - +11)))) + (|> abs + (f/% 1.0) + (f/* deg-denominator) + frac-to-int + ("lux i64 left-shift" +11)))) (def: #export deg-to-frac (-> Deg Frac) - (|>> (:! Nat) to-significand (f// deg-denominator))) + (|>> to-significand (f// deg-denominator))) (macro: #export (alias: tokens) (case tokens |