aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux.lux
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/lux.lux')
-rw-r--r--stdlib/source/lux.lux189
1 files changed, 165 insertions, 24 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index 6bec61741..6e6397eeb 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -867,6 +867,11 @@
#Nil])]))))
(record$ #Nil))
+("lux def" export-meta
+ ("lux check" (#Product Code Code)
+ [(tag$ ["lux" "export?"]) (bool$ true)])
+ (record$ #Nil))
+
("lux def" export?-meta
("lux check" Code
(flag-meta "export?"))
@@ -893,6 +898,11 @@
(#Cons tail #Nil))))))
(record$ #Nil))
+("lux def" doc-meta
+ ("lux check" (#Function Text (#Product Code Code))
+ (function'' [doc] [(tag$ ["lux" "doc"]) (text$ doc)]))
+ (record$ #Nil))
+
("lux def" def:''
("lux check" Macro
(function'' [tokens]
@@ -1104,6 +1114,36 @@
syntax})
)
+(def:'' (n/+ param subject)
+ (#.Cons (doc-meta "Nat(ural) addition.")
+ (#.Cons export-meta
+ #.Nil))
+ (#Function Nat (#Function Nat Nat))
+ ("lux coerce" Nat
+ ("lux int +"
+ ("lux coerce" Int subject)
+ ("lux coerce" Int param))))
+
+(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))))
+
+(def:'' (n/* param subject)
+ (#.Cons (doc-meta "Nat(ural) multiplication.")
+ (#.Cons export-meta
+ #.Nil))
+ (#Function Nat (#Function Nat Nat))
+ ("lux coerce" Nat
+ ("lux int *"
+ ("lux coerce" Int subject)
+ ("lux coerce" Int param))))
+
(def:'' (update-bounds code)
#Nil
(#Function Code Code)
@@ -1119,7 +1159,7 @@
pairs))
[_ (#Form (#Cons [_ (#Tag "lux" "Bound")] (#Cons [_ (#Nat idx)] #Nil)))]
- (form$ (#Cons (tag$ ["lux" "Bound"]) (#Cons (nat$ ("lux nat +" +2 idx)) #Nil)))
+ (form$ (#Cons (tag$ ["lux" "Bound"]) (#Cons (nat$ (n/+ +2 idx)) #Nil)))
[_ (#Form members)]
(form$ (list/map update-bounds members))
@@ -1170,7 +1210,7 @@
#Nil
(#UnivQ #Nil
(#Function ($' List (#Bound +1)) Nat))
- (list/fold (function'' [_ acc] ("lux nat +" +1 acc)) +0 list))
+ (list/fold (function'' [_ acc] (n/+ +1 acc)) +0 list))
(macro:' #export (All tokens)
(#Cons [(tag$ ["lux" "doc"])
@@ -1209,10 +1249,7 @@
body'
[false _]
- (replace-syntax (#Cons [self-name (make-bound ("lux nat *"
- +2 ("lux nat -"
- (list/size names)
- +1)))]
+ (replace-syntax (#Cons [self-name (make-bound (n/* +2 (n/- +1 (list/size names))))]
#Nil)
body')})
#Nil)))))
@@ -1260,10 +1297,7 @@
body'
[false _]
- (replace-syntax (#Cons [self-name (make-bound ("lux nat *"
- +2 ("lux nat -"
- (list/size names)
- +1)))]
+ (replace-syntax (#Cons [self-name (make-bound (n/* +2 (n/- +1 (list/size names))))]
#Nil)
body')})
#Nil)))))
@@ -2163,6 +2197,73 @@
(-> (-> a Bool) ($' List a) Bool))
(list/fold (function' [_2 _1] (if _1 (p _2) false)) true xs))
+(def:''' #export (n/= test subject)
+ (list [(tag$ ["lux" "doc"])
+ (text$ "Nat(ural) equality.")])
+ (-> Nat Nat Bool)
+ ("lux int ="
+ ("lux coerce" Int subject)
+ ("lux coerce" Int test)))
+
+(def:''' (high-bits value)
+ (list)
+ (-> Nat Int)
+ ("lux coerce" Int ("lux bit logical-right-shift" value +32)))
+
+(def:''' low-mask
+ (list)
+ Nat
+ ("lux coerce" Nat
+ ("lux int -"
+ ("lux coerce" Int
+ ("lux bit left-shift" +1 +32))
+ 1)))
+
+(def:''' (low-bits value)
+ (list)
+ (-> Nat Int)
+ ("lux coerce" Int ("lux bit and" value low-mask)))
+
+(def:''' #export (n/< test subject)
+ (list [(tag$ ["lux" "doc"])
+ (text$ "Nat(ural) less-than.")])
+ (-> Nat Nat Bool)
+ (let' [testH (high-bits test)
+ subjectH (high-bits subject)]
+ (if ("lux int <" subjectH testH)
+ true
+ (if ("lux int =" subjectH testH)
+ ("lux int <"
+ (low-bits subject)
+ (low-bits test))
+ false))))
+
+(def:''' #export (n/<= test subject)
+ (list [(tag$ ["lux" "doc"])
+ (text$ "Nat(ural) less-than-equal.")])
+ (-> Nat Nat Bool)
+ (if (n/< test subject)
+ true
+ ("lux int ="
+ ("lux coerce" Int subject)
+ ("lux coerce" Int test))))
+
+(def:''' #export (n/> test subject)
+ (list [(tag$ ["lux" "doc"])
+ (text$ "Nat(ural) greater-than.")])
+ (-> Nat Nat Bool)
+ (n/< subject test))
+
+(def:''' #export (n/>= test subject)
+ (list [(tag$ ["lux" "doc"])
+ (text$ "Nat(ural) greater-than-equal.")])
+ (-> Nat Nat Bool)
+ (if (n/< subject test)
+ true
+ ("lux int ="
+ ("lux coerce" Int subject)
+ ("lux coerce" Int test))))
+
(macro:' #export (do-template tokens)
(list [(tag$ ["lux" "doc"])
(text$ "## By specifying a pattern (with holes), and the input data to fill those holes, repeats the pattern as many times as necessary.
@@ -2181,7 +2282,7 @@
(let' [apply ("lux check" (-> RepEnv ($' List Code))
(function' [env] (list/map (apply-template env) templates)))
num-bindings (list/size bindings')]
- (if (every? (function' [sample] ("lux nat =" num-bindings sample))
+ (if (every? (n/= num-bindings)
(list/map list/size data'))
(|> data'
(join-map (compose apply (make-env bindings')))
@@ -2231,9 +2332,6 @@
true
(<eq-proc> subject test)))]
- [ Nat "lux nat =" "lux nat <" n/= n/< n/<= n/> n/>=
- "Nat(ural) equality." "Nat(ural) less-than." "Nat(ural) less-than-equal." "Nat(ural) greater-than." "Nat(ural) greater-than-equal."]
-
[ Int "lux int =" "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."]
@@ -2244,6 +2342,48 @@
"Frac(tion) equality." "Frac(tion) less-than." "Frac(tion) less-than-equal." "Frac(tion) greater-than." "Frac(tion) greater-than-equal."]
)
+(def:''' #export (n// param subject)
+ (list [(tag$ ["lux" "doc"])
+ (text$ "Nat(ural) division.")])
+ (-> Nat Nat Nat)
+ (if ("lux int <" ("lux coerce" Int param) 0)
+ (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))))]
+ (if (n/< param remainder)
+ quotient
+ ("lux coerce" Nat
+ ("lux int +"
+ ("lux coerce" Int quotient)
+ 1))))))
+
+(def:''' #export (n/% param subject)
+ (list [(tag$ ["lux" "doc"])
+ (text$ "Nat(ural) remainder.")])
+ (-> Nat Nat Nat)
+ (let' [flat ("lux int *"
+ ("lux coerce" Int (n// param subject))
+ ("lux coerce" Int param))]
+ ("lux coerce" Nat
+ ("lux int -"
+ ("lux coerce" Int subject)
+ flat))))
+
(do-template [<type> <name> <op> <doc>]
[(def:''' #export (<name> param subject)
(list [(tag$ ["lux" "doc"])
@@ -2251,12 +2391,6 @@
(-> <type> <type> <type>)
(<op> subject param))]
- [ Nat n/+ "lux nat +" "Nat(ural) addition."]
- [ Nat n/- "lux nat -" "Nat(ural) substraction."]
- [ Nat n/* "lux nat *" "Nat(ural) multiplication."]
- [ Nat n// "lux nat /" "Nat(ural) division."]
- [ Nat n/% "lux nat %" "Nat(ural) remainder."]
-
[ Int i/+ "lux int +" "Int(eger) addition."]
[ Int i/- "lux int -" "Int(eger) substraction."]
[ Int i/* "lux int *" "Int(eger) multiplication."]
@@ -2305,8 +2439,8 @@
[d/min Deg d/< "Deg(ree) minimum."]
[d/max Deg d/> "Deg(ree) maximum."]
- [f/min Frac f/< "Frac minimum."]
- [f/max Frac f/> "Frac minimum."]
+ [f/min Frac f/< "Frac(tion) minimum."]
+ [f/max Frac f/> "Frac(tion) minimum."]
)
(def:''' (bool/encode x)
@@ -5069,13 +5203,20 @@
(-> Ident Text)
(|>> ident/encode (text/compose "#")))
+(do-template [<name> <from> <to>]
+ [(def: #export <name>
+ (-> <from> <to>)
+ (|>> (:! <to>)))]
+
+ [int-to-nat Int Nat]
+ [nat-to-int Nat Int]
+ )
+
(do-template [<name> <op> <from> <to>]
[(def: #export (<name> input)
(-> <from> <to>)
(<op> input))]
- [int-to-nat "lux int to-nat" Int Nat]
- [nat-to-int "lux nat to-int" Nat Int]
[frac-to-deg "lux frac to-deg" Frac Deg]
[deg-to-frac "lux deg to-frac" Deg Frac]
)
generated by cgit v1.2.3 (git 2.25.1) at 2024-08-22 23:28:06 +0000