From 2a3946e713821880ecc47580e754315349f2fe73 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 13 Nov 2017 20:02:18 -0400 Subject: - Type-vars no longer get deleted. - Fixed some bugs. --- stdlib/source/lux.lux | 63 +++++++++++++++++++++++++-------------------------- 1 file changed, 31 insertions(+), 32 deletions(-) (limited to 'stdlib/source/lux.lux') diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index 738183410..9b41010d9 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -1208,8 +1208,8 @@ (def:'' (length list) #;Nil (#UnivQ #Nil - (#Function ($' List (#Bound +1)) Int)) - (fold (function'' [_ acc] ("lux int +" 1 acc)) 0 list)) + (#Function ($' List (#Bound +1)) Nat)) + (fold (function'' [_ acc] ("lux nat +" +1 acc)) +0 list)) (macro:' #export (All tokens) (#Cons [(tag$ ["lux" "doc"]) @@ -1250,8 +1250,7 @@ [false _] (replace-syntax (#Cons [self-name (make-bound ("lux nat *" +2 ("lux nat -" - ("lux int to-nat" - (length names)) + (length names) +1)))] #Nil) body')}) @@ -1302,7 +1301,7 @@ [false _] (replace-syntax (#Cons [self-name (make-bound ("lux nat *" +2 ("lux nat -" - ("lux int to-nat" (length names)) + (length names) +1)))] #Nil) body')}) @@ -1634,8 +1633,8 @@ (#Named ["lux" "Monad"] (All [m] (& (All [a] (-> a ($' m a))) - (All [a b] (-> ($' m a) - (-> a ($' m b)) + (All [a b] (-> (-> a ($' m b)) + ($' m a) ($' m b))))))) (def:''' Monad @@ -1645,7 +1644,7 @@ (function' [x] (#Some x)) #bind - (function' [ma f] + (function' [f ma] ("lux case" ma {#None #None (#Some a) (f a)}))}) @@ -1659,7 +1658,7 @@ (#Right state x))) #bind - (function' [ma f] + (function' [f ma] (function' [state] ("lux case" (ma state) {(#Left msg) @@ -1682,8 +1681,8 @@ _ (form$ (list g!bind - value - (form$ (list (text$ "lux function") (symbol$ ["" ""]) var body'))))})))) + (form$ (list (text$ "lux function") (symbol$ ["" ""]) var body')) + value))})))) body (reverse (as-pairs bindings)))] (return (list (form$ (list (text$ "lux case") @@ -1770,7 +1769,7 @@ (def:''' (text/compose x y) #Nil (-> Text Text Text) - ("lux text append" x y)) + ("lux text concat" x y)) (def:''' (ident/encode ident) #Nil @@ -2197,7 +2196,7 @@ (let' [apply ("lux check" (-> RepEnv ($' List Code)) (function' [env] (map (apply-template env) templates))) num-bindings (length bindings')] - (if (every? (function' [sample] ("lux int =" num-bindings sample)) + (if (every? (function' [sample] ("lux nat =" num-bindings sample)) (map length data')) (|> data' (join-map (. apply (make-env bindings'))) @@ -2211,12 +2210,12 @@ (fail "Wrong syntax for do-template")})) (do-template [ - <=-proc> <=-name> + <<-doc> <<=-doc> <>-doc> <>=-doc>] - [(def:''' #export (<=-name> test subject) + [(def:''' #export ( test subject) (list [(tag$ ["lux" "doc"]) (text$ )]) (-> Bool) - (<=-proc> subject test)) + ( subject test)) (def:''' #export ( test subject) (list [(tag$ ["lux" "doc"]) (text$ <<-doc>)]) @@ -2228,7 +2227,7 @@ (-> Bool) (if ( subject test) true - (<=-proc> subject test))) + ( subject test))) (def:''' #export ( test subject) (list [(tag$ ["lux" "doc"]) (text$ <>-doc>)]) @@ -2240,7 +2239,7 @@ (-> Bool) (if ( test subject) true - (<=-proc> subject test)))] + ( 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."] @@ -2343,9 +2342,9 @@ (let' [loop ("lux check" (-> Nat Text Text) (function' recur [input output] (if ("lux nat =" input +0) - ("lux text append" "+" output) + ("lux text concat" "+" output) (recur ("lux nat /" input +10) - ("lux text append" (digit-to-text ("lux nat %" input +10)) + ("lux text concat" (digit-to-text ("lux nat %" input +10)) output)))))] (loop value ""))})) @@ -2367,9 +2366,9 @@ (("lux check" (-> Int Text Text) (function' recur [input output] (if (i.= 0 input) - ("lux text append" sign output) + ("lux text concat" sign output) (recur (i./ 10 input) - ("lux text append" (|> input (i.% 10) ("lux coerce" Nat) digit-to-text) + ("lux text concat" (|> 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))))) @@ -2381,8 +2380,8 @@ (def:''' (multiple? div n) #Nil - (-> Int Int Bool) - (i.= 0 (i.% div n))) + (-> Nat Nat Bool) + (|> n (n.% div) (n.= +0))) (def:''' #export (not x) (list [(tag$ ["lux" "doc"]) @@ -2982,7 +2981,7 @@ (op x y))")]) (case tokens (^ (list [_ (#Tuple bindings)] body)) - (if (multiple? 2 (length bindings)) + (if (multiple? +2 (length bindings)) (|> bindings as-pairs reverse (fold (: (-> [Code Code] Code Code) (function' [lr body'] @@ -3436,15 +3435,15 @@ (def: (nth idx xs) (All [a] - (-> Int (List a) (Maybe a))) + (-> Nat (List a) (Maybe a))) (case xs #Nil #None (#Cons x xs') - (if (i.= idx 0) + (if (n.= +0 idx) (#Some x) - (nth (i.- 1 idx) xs') + (nth (n.- +1 idx) xs') ))) (def: (beta-reduce env type) @@ -3479,7 +3478,7 @@ (#Function (beta-reduce env ?input) (beta-reduce env ?output)) (#Bound idx) - (case (nth ("lux nat to-int" idx) env) + (case (nth idx env) (#Some bound) bound @@ -4073,7 +4072,7 @@ parts (let [[ups parts'] (split-with (text/= "..") parts) num-ups (length ups)] - (if (i.= num-ups 0) + (if (n.= +0 num-ups) (return module) (case (nth num-ups (split-module-contexts current-module)) #None @@ -4433,7 +4432,7 @@ (n.odd? num) \"odd\" ## else-branch \"???\")"} - (if (i.= 0 (i.% 2 (length tokens))) + (if (n.= +0 (n.% +2 (length tokens))) (fail "cond requires an even number of arguments.") (case (reverse tokens) (^ (list& else branches')) @@ -4971,7 +4970,7 @@ (do Monad [bindings' (monad/map Monad get-name bindings) data' (monad/map Monad tuple->list data)] - (if (every? (i.= (length bindings')) (map length data')) + (if (every? (n.= (length bindings')) (map length data')) (let [apply (: (-> RepEnv (List Code)) (function [env] (map (apply-template env) templates)))] (|> data' -- cgit v1.2.3