From a0889b2ee76c1ae7a9a5bbe2eec9f051b4f341e4 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 26 Jul 2019 21:23:27 -0400 Subject: No more "n/"-prefixed functions. --- stdlib/source/lux.lux | 178 +++++++++++++++++--------------------------------- 1 file changed, 59 insertions(+), 119 deletions(-) (limited to 'stdlib/source/lux.lux') diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index 05a4ece62..9cc2254b2 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -1049,17 +1049,7 @@ syntax} syntax)) -(def:'' #export (n/+ param subject) - (#.Cons (doc-meta "Nat(ural) addition.") #.Nil) - (#Function Nat (#Function Nat Nat)) - ("lux i64 +" subject param)) - -(def:'' #export (n/- param subject) - (#.Cons (doc-meta "Nat(ural) substraction.") #.Nil) - (#Function Nat (#Function Nat Nat)) - ("lux i64 -" param subject)) - -(def:'' #export (n/* param subject) +(def:'' (n/* param subject) (#.Cons (doc-meta "Nat(ural) multiplication.") #.Nil) (#Function Nat (#Function Nat Nat)) ("lux coerce" Nat @@ -1081,7 +1071,7 @@ pairs)) [_ (#Form (#Cons [_ (#Tag "lux" "Parameter")] (#Cons [_ (#Nat idx)] #Nil)))] - (form$ (#Cons (tag$ ["lux" "Parameter"]) (#Cons (nat$ (n/+ 2 idx)) #Nil))) + (form$ (#Cons (tag$ ["lux" "Parameter"]) (#Cons (nat$ ("lux i64 +" 2 idx)) #Nil))) [_ (#Form members)] (form$ (list@map update-parameters members)) @@ -1132,7 +1122,7 @@ #Nil (#UnivQ #Nil (#Function ($' List (#Parameter 1)) Nat)) - (list@fold (function'' [_ acc] (n/+ 1 acc)) 0 list)) + (list@fold (function'' [_ acc] ("lux i64 +" 1 acc)) 0 list)) (macro:' #export (All tokens) (#Cons [(tag$ ["lux" "doc"]) @@ -1168,7 +1158,7 @@ body' [#0 _] - (replace-syntax (#Cons [self-name (make-parameter (n/* 2 (n/- 1 (list@size names))))] + (replace-syntax (#Cons [self-name (make-parameter (n/* 2 ("lux i64 -" 1 (list@size names))))] #Nil) body')} [(text@= "" self-name) names]) @@ -1212,7 +1202,7 @@ body' [#0 _] - (replace-syntax (#Cons [self-name (make-parameter (n/* 2 (n/- 1 (list@size names))))] + (replace-syntax (#Cons [self-name (make-parameter (n/* 2 ("lux i64 -" 1 (list@size names))))] #Nil) body')} [(text@= "" self-name) names]) @@ -2117,12 +2107,6 @@ (-> (-> a Bit) ($' List a) Bit)) (list@fold (function' [_2 _1] (if _1 (p _2) #0)) #1 xs)) -(def:''' #export (n/= reference sample) - (list [(tag$ ["lux" "doc"]) - (text$ "Nat(ural) equivalence.")]) - (-> Nat Nat Bit) - ("lux i64 =" reference sample)) - (def:''' (high-bits value) (list) (-> ($' I64 Any) I64) @@ -2138,9 +2122,8 @@ (-> ($' I64 Any) I64) ("lux i64 and" low-mask value)) -(def:''' #export (n/< reference sample) - (list [(tag$ ["lux" "doc"]) - (text$ "Nat(ural) less-than.")]) +(def:''' (n/< reference sample) + (list) (-> Nat Nat Bit) (let' [referenceH (high-bits reference) sampleH (high-bits sample)] @@ -2152,28 +2135,13 @@ (low-bits sample)) #0)))) -(def:''' #export (n/<= reference sample) - (list [(tag$ ["lux" "doc"]) - (text$ "Nat(ural) less-than-equal.")]) +(def:''' (n/<= reference sample) + (list) (-> Nat Nat Bit) (if (n/< reference sample) #1 ("lux i64 =" reference sample))) -(def:''' #export (n/> reference sample) - (list [(tag$ ["lux" "doc"]) - (text$ "Nat(ural) greater-than.")]) - (-> Nat Nat Bit) - (n/< sample reference)) - -(def:''' #export (n/>= reference sample) - (list [(tag$ ["lux" "doc"]) - (text$ "Nat(ural) greater-than-equal.")]) - (-> Nat Nat Bit) - (if (n/< sample reference) - #1 - ("lux i64 =" reference sample))) - (macro:' #export (template tokens) (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" @@ -2187,7 +2155,7 @@ (let' [apply ("lux check" (-> RepEnv ($' List Code)) (function' [env] (list@map (apply-template env) templates))) num-bindings (list@size bindings')] - (if (every? (n/= num-bindings) + (if (every? (function' [size] ("lux i64 =" num-bindings size)) (list@map list@size data')) (|> data' (join-map (compose apply (make-env bindings'))) @@ -2203,9 +2171,8 @@ (fail "Wrong syntax for template")} tokens)) -(def:''' #export (n// param subject) - (list [(tag$ ["lux" "doc"]) - (text$ "Nat(ural) division.")]) +(def:''' (n// param subject) + (list) (-> Nat Nat Nat) (if ("lux i64 <" +0 ("lux coerce" Int param)) (if (n/< param subject) @@ -2223,37 +2190,20 @@ quotient ("lux i64 +" 1 quotient))))) -(def:''' #export (n//% param subject) - (list [(tag$ ["lux" "doc"]) - (text$ "Nat(ural) [division remainder].")]) - (-> Nat Nat (#Product Nat Nat)) - (let' [div (n// param subject) - flat ("lux i64 *" - ("lux coerce" Int param) - ("lux coerce" Int div))] - [div ("lux i64 -" flat subject)])) - -(def:''' #export (n/% param subject) - (list [(tag$ ["lux" "doc"]) - (text$ "Nat(ural) remainder.")]) +(def:''' (n/% param subject) + (list) (-> Nat Nat Nat) (let' [flat ("lux i64 *" ("lux coerce" Int param) ("lux coerce" Int (n// param subject)))] ("lux i64 -" flat subject))) -(template [ ] - [(def:''' #export ( left right) - (list [(tag$ ["lux" "doc"]) - (text$ )]) - (-> ) - (if ( right left) - left - right))] - - [n/min Nat n/< "Nat(ural) minimum."] - [n/max Nat n/> "Nat(ural) maximum."] - ) +(def:''' (n/min left right) + (list) + (-> Nat Nat Nat) + (if (n/< right left) + left + right)) (def:''' (bit@encode x) #Nil @@ -2279,7 +2229,7 @@ _ (let' [loop ("lux check" (-> Nat Text Text) (function' recur [input output] - (if (n/= 0 input) + (if ("lux i64 =" 0 input) output (recur (n// 10 input) (text@compose (|> input (n/% 10) digit-to-text) @@ -2320,7 +2270,7 @@ (def:''' (multiple? div n) #Nil (-> Nat Nat Bit) - (|> n (n/% div) (n/= 0))) + (|> n (n/% div) ("lux i64 =" 0))) (def:''' #export (not x) (list [(tag$ ["lux" "doc"]) @@ -2659,7 +2609,7 @@ #scope-type-vars scope-type-vars} (#Right {#info info #source source #current-module _ #modules modules #scopes scopes #type-context types #host host - #seed (n/+ 1 seed) #expected expected + #seed ("lux i64 +" 1 seed) #expected expected #cursor cursor #extensions extensions #scope-type-vars scope-type-vars} (local-identifier$ ($_ text@compose "__gensym__" prefix (nat@encode seed))))} @@ -3301,7 +3251,7 @@ (def: (last-index-of' part part-size since text) (-> Text Nat Nat Text (Maybe Nat)) - (case ("lux text index" (n/+ part-size since) part text) + (case ("lux text index" ("lux i64 +" part-size since) part text) #None (#Some since) @@ -3369,7 +3319,7 @@ (#Some idx) (list& ("lux text clip" 0 idx input) (text@split-all-with splitter - ("lux text clip" (n/+ 1 idx) ("lux text size" input) input))))) + ("lux text clip" ("lux i64 +" 1 idx) ("lux text size" input) input))))) (def: (nth idx xs) (All [a] @@ -3379,9 +3329,9 @@ #None (#Cons x xs') - (if (n/= 0 idx) + (if ("lux i64 =" 0 idx) (#Some x) - (nth (n/- 1 idx) xs') + (nth ("lux i64 -" 1 idx) xs') ))) (def: (beta-reduce env type) @@ -3896,8 +3846,8 @@ relatives (#Some found) - (if (n/= relatives found) - (count-relatives (n/+ 1 relatives) input) + (if ("lux i64 =" relatives found) + (count-relatives ("lux i64 +" 1 relatives) input) relatives))) (def: (list@take amount list) @@ -3907,7 +3857,7 @@ #Nil [_ (#Cons head tail)] - (#Cons head (list@take (n/- 1 amount) tail)))) + (#Cons head (list@take ("lux i64 -" 1 amount) tail)))) (def: (list@drop amount list) (All [a] (-> Nat (List a) (List a))) @@ -3916,7 +3866,7 @@ list [_ (#Cons _ tail)] - (list@drop (n/- 1 amount) tail))) + (list@drop ("lux i64 -" 1 amount) tail))) (def: (clean-module nested? relative-root module) (-> Bit Text Text (Meta Text)) @@ -3928,7 +3878,7 @@ relatives (let [parts (text@split-all-with ..module-separator relative-root) - jumps (n/- 1 relatives)] + jumps ("lux i64 -" 1 relatives)] (if (n/< (list@size parts) jumps) (let [prefix (|> parts list@reverse @@ -4173,7 +4123,7 @@ #Nil (#Cons [var bound] bindings') - (if (n/= idx var) + (if ("lux i64 =" idx var) bound (find-type-var idx bindings')))) @@ -4333,12 +4283,12 @@ (macro: #export (cond tokens) {#.doc (text$ ($_ "lux text concat" "## Branching structures with multiple test conditions." ..new-line - "(cond (n/even? num) ''even''" ..new-line - " (n/odd? num) ''odd''" + "(cond (even? num) ''even''" ..new-line + " (odd? num) ''odd''" __paragraph " ## else-branch" ..new-line " ''???'')"))} - (if (n/= 0 (n/% 2 (list@size tokens))) + (if ("lux i64 =" 0 (n/% 2 (list@size tokens))) (fail "cond requires an uneven number of arguments.") (case (list@reverse tokens) (^ (list& else branches')) @@ -4356,7 +4306,7 @@ (All [a] (-> Nat (List a) (List [Nat a]))) (case xs (#Cons x xs') - (#Cons [idx x] (enumerate' (n/+ 1 idx) xs')) + (#Cons [idx x] (enumerate' ("lux i64 +" 1 idx) xs')) #Nil #Nil)) @@ -4389,7 +4339,7 @@ (let [pattern (record$ (list@map (: (-> [Name [Nat Type]] [Code Code]) (function (_ [[r-prefix r-name] [r-idx r-type]]) [(tag$ [r-prefix r-name]) - (if (n/= idx r-idx) + (if ("lux i64 =" idx r-idx) g!output g!_)])) (zip2 tags (enumerate members))))] @@ -4423,7 +4373,7 @@ pattern (|> tags enumerate (list@map (function (_ [tag-idx tag]) - (if (n/= my-tag-index tag-idx) + (if ("lux i64 =" my-tag-index tag-idx) g!output g!_))) tuple$) @@ -4714,7 +4664,7 @@ output (record$ (list@map (: (-> [Name Nat Code] [Code Code]) (function (_ [r-slot-name r-idx r-var]) [(tag$ r-slot-name) - (if (n/= idx r-idx) + (if ("lux i64 =" idx r-idx) value r-var)])) pattern'))] @@ -4801,7 +4751,7 @@ output (record$ (list@map (: (-> [Name Nat Code] [Code Code]) (function (_ [r-slot-name r-idx r-var]) [(tag$ r-slot-name) - (if (n/= idx r-idx) + (if ("lux i64 =" idx r-idx) (` ((~ fun) (~ r-var))) r-var)])) pattern'))] @@ -4882,13 +4832,15 @@ (do maybe-monad [bindings' (monad@map maybe-monad get-short bindings) data' (monad@map maybe-monad tuple->list data)] - (if (every? (n/= (list@size bindings')) (list@map list@size data')) - (let [apply (: (-> RepEnv (List Code)) - (function (_ env) (list@map (apply-template env) templates)))] - (|> data' - (join-map (compose apply (make-env bindings'))) - wrap)) - #None))) + (let [num-bindings (list@size bindings')] + (if (every? (|>> ("lux i64 =" num-bindings)) + (list@map list@size data')) + (let [apply (: (-> RepEnv (List Code)) + (function (_ env) (list@map (apply-template env) templates)))] + (|> data' + (join-map (compose apply (make-env bindings'))) + wrap)) + #None)))) (#Some output) (return (list@compose output branches)) @@ -4964,10 +4916,10 @@ (def: (cursor-padding baseline [_ old-line old-column] [_ new-line new-column]) (-> Nat Cursor Cursor Text) - (if (n/= old-line new-line) - (text@join-with "" (repeat (.int (n/- old-column new-column)) " ")) - (let [extra-lines (text@join-with "" (repeat (.int (n/- old-line new-line)) ..new-line)) - space-padding (text@join-with "" (repeat (.int (n/- baseline new-column)) " "))] + (if ("lux i64 =" old-line new-line) + (text@join-with "" (repeat (.int ("lux i64 -" old-column new-column)) " ")) + (let [extra-lines (text@join-with "" (repeat (.int ("lux i64 -" old-line new-line)) ..new-line)) + space-padding (text@join-with "" (repeat (.int ("lux i64 -" baseline new-column)) " "))] (text@compose extra-lines space-padding)))) (def: (text@size x) @@ -4976,7 +4928,7 @@ (def: (update-cursor [file line column] code-text) (-> Cursor Text Cursor) - [file line (n/+ column (text@size code-text))]) + [file line ("lux i64 +" column (text@size code-text))]) (def: (delim-update-cursor [file line column]) (-> Cursor Cursor) @@ -5485,18 +5437,6 @@ _ (fail (..wrong-syntax-error ["lux" "name-of"])))) -(template [ <%> <=> <0> <2>] - [(def: #export ( n) - (-> Bit) - (<=> <0> (<%> <2> n))) - - (def: #export ( n) - (-> Bit) - (not ( n)))] - - [Nat n/even? n/odd? n/% n/= 0 2] - ) - (def: (get-scope-type-vars state) (Meta (List Nat)) (case state @@ -5514,7 +5454,7 @@ #None (#Cons x xs') - (if (n/= 0 idx) + (if ("lux i64 =" 0 idx) (#Some x) (list-at (dec idx) xs')))) @@ -5555,7 +5495,7 @@ (macro: #export (^@ tokens) {#.doc (doc "Allows you to simultaneously bind and de-structure a value." (def: (hash (^@ set [Hash _])) - (list@fold (function (_ elem acc) (n/+ (:: Hash hash elem) acc)) + (list@fold (function (_ elem acc) (+ (:: Hash hash elem) acc)) 0 (to-list set))))} (case tokens @@ -5571,7 +5511,7 @@ (macro: #export (^|> tokens) {#.doc (doc "Pipes the value being pattern-matched against prior to binding it to a variable." (case input - (^|> value [inc (n/% 10) (n/max 1)]) + (^|> value [inc (% 10) (max 1)]) (foo value)))} (case tokens (^ (list& [_meta (#Form (list [_ (#Identifier ["" name])] [_ (#Tuple steps)]))] body branches)) @@ -5739,7 +5679,7 @@ (macro: #export (char tokens compiler) (case tokens (^multi (^ (list [_ (#Text input)])) - (n/= 1 ("lux text size" input))) + (|> input "lux text size" ("lux i64 =" 1))) (|> input ("lux text char" 0) nat$ list [compiler] #Right) -- cgit v1.2.3