diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/lux.lux | 178 | 
1 files changed, 59 insertions, 119 deletions
| 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 [<name> <type> <test> <doc>] -  [(def:''' #export (<name> left right) -            (list [(tag$ ["lux" "doc"]) -                   (text$ <doc>)]) -            (-> <type> <type> <type>) -            (if (<test> 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 [<type> <even> <odd> <%> <=> <0> <2>] -  [(def: #export (<even> n) -     (-> <type> Bit) -     (<=> <0> (<%> <2> n))) - -   (def: #export (<odd> n) -     (-> <type> Bit) -     (not (<even> 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<a> _])) -                (list@fold (function (_ elem acc) (n/+ (:: Hash<a> hash elem) acc)) +                (list@fold (function (_ elem acc) (+ (:: Hash<a> 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) | 
