From 3c93d7a3aabaa49c67f9a498bc0d70f0af7f09d0 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 5 May 2018 20:42:41 -0400 Subject: - Removed Void and Unit as kinds of types. - Changed the value of "unit" in the old LuxC to match the one in new-luxc. --- stdlib/source/lux.lux | 283 +++++++++++++++++++++----------------------------- 1 file changed, 120 insertions(+), 163 deletions(-) (limited to 'stdlib/source/lux.lux') diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index dc469633f..6bec61741 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -1,23 +1,57 @@ ## Basic types ("lux def" dummy-cursor - ("lux check" (+4 (+0 "#Text" (+0)) (+4 (+0 "#Nat" (+0)) (+0 "#Nat" (+0)))) + ("lux check" (+2 (+0 "#Text" (+0)) + (+2 (+0 "#Nat" (+0)) + (+0 "#Nat" (+0)))) ["" +0 +0]) [["" +0 +0] (+10 (+1 [[["" +0 +0] (+7 ["lux" "export?"])] [["" +0 +0] (+0 true)]] (+0)))]) +## (type: Top +## (Ex [a] a)) +("lux def" Top + (+10 ["lux" "Top"] + (+8 (+0) (+4 +1))) + [dummy-cursor + (+10 (+1 [[dummy-cursor (+7 ["lux" "type?"])] + [dummy-cursor (+0 true)]] + (+1 [[dummy-cursor (+7 ["lux" "export?"])] + [dummy-cursor (+0 true)]] + (+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.")]] + (+0)))))]) + +## (type: Bottom +## (All [a] a)) +("lux def" Bottom + (+10 ["lux" "Bottom"] + (+7 (+0) (+4 +1))) + [dummy-cursor + (+10 (+1 [[dummy-cursor (+7 ["lux" "type?"])] + [dummy-cursor (+0 true)]] + (+1 [[dummy-cursor (+7 ["lux" "export?"])] + [dummy-cursor (+0 true)]] + (+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.")]] + (+0)))))]) + ## (type: (List a) ## #Nil ## (#Cons a (List a))) ("lux def" List - (+12 ["lux" "List"] - (+9 (+0) - (+3 ## "lux.Nil" - (+2) + (+10 ["lux" "List"] + (+7 (+0) + (+1 ## "lux.Nil" + Top ## "lux.Cons" - (+4 (+6 +1) - (+11 (+6 +1) (+6 +0)))))) + (+2 (+4 +1) + (+9 (+4 +1) (+4 +0)))))) [dummy-cursor (+10 (+1 [[dummy-cursor (+7 ["lux" "type?"])] [dummy-cursor (+0 true)]] @@ -32,7 +66,7 @@ (+0)))))))]) ("lux def" Bool - (+12 ["lux" "Bool"] + (+10 ["lux" "Bool"] (+0 "#Bool" #Nil)) [dummy-cursor (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] @@ -44,7 +78,7 @@ #Nil))))]) ("lux def" Nat - (+12 ["lux" "Nat"] + (+10 ["lux" "Nat"] (+0 "#Nat" #Nil)) [dummy-cursor (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] @@ -58,7 +92,7 @@ #Nil))))]) ("lux def" Int - (+12 ["lux" "Int"] + (+10 ["lux" "Int"] (+0 "#Int" #Nil)) [dummy-cursor (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] @@ -70,7 +104,7 @@ #Nil))))]) ("lux def" Frac - (+12 ["lux" "Frac"] + (+10 ["lux" "Frac"] (+0 "#Frac" #Nil)) [dummy-cursor (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] @@ -82,7 +116,7 @@ #Nil))))]) ("lux def" Deg - (+12 ["lux" "Deg"] + (+10 ["lux" "Deg"] (+0 "#Deg" #Nil)) [dummy-cursor (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] @@ -96,7 +130,7 @@ #Nil))))]) ("lux def" Text - (+12 ["lux" "Text"] + (+10 ["lux" "Text"] (+0 "#Text" #Nil)) [dummy-cursor (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] @@ -107,33 +141,9 @@ [dummy-cursor (+5 "Your standard, run-of-the-mill string values.")]] #Nil))))]) -("lux def" Void - (+12 ["lux" "Void"] - (+1)) - [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 "An unusual type that possesses no value, and thus cannot be instantiated.")]] - #Nil))))]) - -("lux def" Unit - (+12 ["lux" "Unit"] - (+2)) - [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 "An unusual type that only possesses a single value: []")]] - #Nil))))]) - ("lux def" Ident - (+12 ["lux" "Ident"] - (+4 Text Text)) + (+10 ["lux" "Ident"] + (+2 Text Text)) [dummy-cursor (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] [dummy-cursor (+0 true)]] @@ -149,12 +159,12 @@ ## #None ## (#Some a)) ("lux def" Maybe - (+12 ["lux" "Maybe"] - (+9 #Nil - (+3 ## "lux.None" - (+2) + (+10 ["lux" "Maybe"] + (+7 #Nil + (+1 ## "lux.None" + Top ## "lux.Some" - (+6 +1)))) + (+4 +1)))) [dummy-cursor (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] [dummy-cursor (+0 true)]] @@ -170,8 +180,6 @@ ## (type: #rec Type ## (#Primitive Text (List Type)) -## #Void -## #Unit ## (#Sum Type Type) ## (#Product Type Type) ## (#Function Type Type) @@ -184,41 +192,37 @@ ## (#Named Ident Type) ## ) ("lux def" Type - (+12 ["lux" "Type"] - ("lux case" ("lux check type" (+11 (+6 +1) (+6 +0))) + (+10 ["lux" "Type"] + ("lux case" ("lux check type" (+9 (+4 +1) (+4 +0))) {Type - ("lux case" ("lux check type" (+11 Type List)) + ("lux case" ("lux check type" (+9 Type List)) {Type-List - ("lux case" ("lux check type" (+4 Type Type)) + ("lux case" ("lux check type" (+2 Type Type)) {Type-Pair - (+11 Void - (+9 #Nil - (+3 ## "lux.Primitive" - (+4 Text Type-List) - (+3 ## "lux.Void" - (+2) - (+3 ## "lux.Unit" - (+2) - (+3 ## "lux.Sum" - Type-Pair - (+3 ## "lux.Product" - Type-Pair - (+3 ## "lux.Function" - Type-Pair - (+3 ## "lux.Bound" - Nat - (+3 ## "lux.Var" - Nat - (+3 ## "lux.Ex" - Nat - (+3 ## "lux.UnivQ" - (+4 Type-List Type) - (+3 ## "lux.ExQ" - (+4 Type-List Type) - (+3 ## "lux.Apply" - Type-Pair - ## "lux.Named" - (+4 Ident Type)))))))))))))))})})})) + (+9 Bottom + (+7 #Nil + (+1 ## "lux.Primitive" + (+2 Text Type-List) + (+1 ## "lux.Sum" + Type-Pair + (+1 ## "lux.Product" + Type-Pair + (+1 ## "lux.Function" + Type-Pair + (+1 ## "lux.Bound" + Nat + (+1 ## "lux.Var" + Nat + (+1 ## "lux.Ex" + Nat + (+1 ## "lux.UnivQ" + (+2 Type-List Type) + (+1 ## "lux.ExQ" + (+2 Type-List Type) + (+1 ## "lux.Apply" + Type-Pair + ## "lux.Named" + (+2 Ident Type)))))))))))))})})})) [dummy-cursor (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] [dummy-cursor (+0 true)]] @@ -226,57 +230,23 @@ [dummy-cursor (+0 true)]] (#Cons [[dummy-cursor (+7 ["lux" "tags"])] [dummy-cursor (+9 (#Cons [dummy-cursor (+5 "Primitive")] - (#Cons [dummy-cursor (+5 "Void")] - (#Cons [dummy-cursor (+5 "Unit")] - (#Cons [dummy-cursor (+5 "Sum")] - (#Cons [dummy-cursor (+5 "Product")] - (#Cons [dummy-cursor (+5 "Function")] - (#Cons [dummy-cursor (+5 "Bound")] - (#Cons [dummy-cursor (+5 "Var")] - (#Cons [dummy-cursor (+5 "Ex")] - (#Cons [dummy-cursor (+5 "UnivQ")] - (#Cons [dummy-cursor (+5 "ExQ")] - (#Cons [dummy-cursor (+5 "Apply")] - (#Cons [dummy-cursor (+5 "Named")] - #Nil))))))))))))))]] + (#Cons [dummy-cursor (+5 "Sum")] + (#Cons [dummy-cursor (+5 "Product")] + (#Cons [dummy-cursor (+5 "Function")] + (#Cons [dummy-cursor (+5 "Bound")] + (#Cons [dummy-cursor (+5 "Var")] + (#Cons [dummy-cursor (+5 "Ex")] + (#Cons [dummy-cursor (+5 "UnivQ")] + (#Cons [dummy-cursor (+5 "ExQ")] + (#Cons [dummy-cursor (+5 "Apply")] + (#Cons [dummy-cursor (+5 "Named")] + #Nil))))))))))))]] (#Cons [[dummy-cursor (+7 ["lux" "doc"])] [dummy-cursor (+5 "This type represents the data-structures that are used to specify types themselves.")]] (#Cons [[dummy-cursor (+7 ["lux" "type-rec?"])] [dummy-cursor (+0 true)]] #Nil))))))]) -## (type: Top -## (Ex [a] a)) -("lux def" Top - (#Named ["lux" "Top"] - (#ExQ #Nil (#Bound +1))) - [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 "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.")]] - #Nil))))]) - -## (type: Bottom -## (All [a] a)) -("lux def" Bottom - (#Named ["lux" "Bottom"] - (#UnivQ #Nil (#Bound +1))) - [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 "The type of things whose type is unknown or undefined. - - Useful for expressions that cause errors or other \"extraordinary\" conditions.")]] - #Nil))))]) - ## (type: Cursor ## {#module Text ## #line Nat @@ -582,12 +552,12 @@ (#Named ["lux" "Module-State"] (#Sum ## #Active - Unit + Top (#Sum ## #Compiled - Unit + Top ## #Cached - Unit))) + Top))) (record$ (#Cons [(tag$ ["lux" "tags"]) (tuple$ (#Cons (text$ "Active") (#Cons (text$ "Compiled") (#Cons (text$ "Cached") #Nil))))] default-def-meta-exported))) @@ -669,11 +639,11 @@ ("lux def" Mode (#Named ["lux" "Mode"] (#Sum ## Build - #Unit + Top (#Sum ## Eval - #Unit + Top ## REPL - #Unit))) + Top))) (record$ (#Cons [(tag$ ["lux" "tags"]) (tuple$ (#Cons (text$ "Build") (#Cons (text$ "Eval") @@ -717,8 +687,8 @@ ## #expected (Maybe Type) ## #seed Nat ## #scope-type-vars (List Nat) -## #extensions Void -## #host Void}) +## #extensions Bottom +## #host Bottom}) ("lux def" Compiler (#Named ["lux" "Compiler"] (#Product ## "lux.info" @@ -742,9 +712,9 @@ (#Product ## scope-type-vars (#Apply Nat List) (#Product ## extensions - Void + Bottom ## "lux.host" - Void)))))))))))) + Bottom)))))))))))) (record$ (#Cons [(tag$ ["lux" "tags"]) (tuple$ (#Cons (text$ "info") (#Cons (text$ "source") @@ -1210,7 +1180,7 @@ ## A name can be provided, to specify a recursive type. (All List [a] - (| Unit + (| Top [a (List a)]))")] #Nil) (let'' [self-name tokens] ("lux case" tokens @@ -1363,12 +1333,12 @@ (text$ "## Tuple types: (& Text Int Bool) - ## The empty tuple, a.k.a. Unit. + ## Top. (&)")] #Nil) ("lux case" (list/reverse tokens) {#Nil - (return (list (tag$ ["lux" "Unit"]))) + (return (list (symbol$ ["lux" "Top"]))) (#Cons last prevs) (return (list (list/fold (function'' [left right] (form$ (list (tag$ ["lux" "Product"]) left right))) @@ -1381,12 +1351,12 @@ (text$ "## Variant types: (| Text Int Bool) - ## The empty tuple, a.k.a. Void. + ## Bottom. (|)")] #Nil) ("lux case" (list/reverse tokens) {#Nil - (return (list (tag$ ["lux" "Void"]))) + (return (list (symbol$ ["lux" "Bottom"]))) (#Cons last prevs) (return (list (list/fold (function'' [left right] (form$ (list (tag$ ["lux" "Sum"]) left right))) @@ -1763,7 +1733,7 @@ (text$ "Logs message to standard output. Useful for debugging.")]) - (-> Text Unit) + (-> Text Top) ("lux io log" message)) (def:''' (text/compose x y) @@ -2698,7 +2668,7 @@ (#Cons type #Nil) ("lux case" type {[_ (#Tag "" member-name)] - (return [(` #.Unit) (#Some (list member-name))]) + (return [(` .Top) (#Some (list member-name))]) [_ (#Form (#Cons [_ (#Tag "" member-name)] member-types))] (return [(` (& (~+ member-types))) (#Some (list member-name))]) @@ -2713,7 +2683,7 @@ (function' [case] ("lux case" case {[_ (#Tag "" member-name)] - (return [member-name (` Unit)]) + (return [member-name (` .Top)]) [_ (#Form (#Cons [_ (#Tag "" member-name)] (#Cons member-type #Nil)))] (return [member-name member-type]) @@ -2756,7 +2726,7 @@ {(#Cons [_ (#Symbol "" name)] (#Cons body #Nil)) (let' [body' (replace-syntax (list [name (` (#.Apply (~ (make-bound +1)) (~ (make-bound +0))))]) (update-bounds body))] - (return (list (` (#.Apply #.Void (#.UnivQ #.Nil (~ body'))))))) + (return (list (` (#.Apply .Bottom (#.UnivQ #.Nil (~ body'))))))) _ (fail "Wrong syntax for Rec")})) @@ -3827,9 +3797,9 @@ (if (empty? args) (let [g!param (symbol$ ["" ""]) prime-name (symbol$ ["" name]) - type+ (replace-syntax (list [name (` ((~ prime-name) #.Void))]) type)] + type+ (replace-syntax (list [name (` ((~ prime-name) .Bottom))]) type)] (#Some (` ((All (~ prime-name) [(~ g!param)] (~ type+)) - #.Void)))) + .Bottom)))) #None) (case args #Nil @@ -4357,12 +4327,6 @@ _ ($_ text/compose "(" name " " (|> params (list/map type/show) (interpose " ") list/reverse (list/fold text/compose "")) ")")) - #Void - "Void" - - #Unit - "Unit" - (#Sum _) ($_ text/compose "(| " (|> (flatten-variant type) (list/map type/show) (interpose " ") list/reverse (list/fold text/compose "")) ")") @@ -4630,10 +4594,10 @@ openings+options (parse-openings options) #let [[openings options] openings+options] current-module current-module-name - #let [test-referrals (: (-> Text (List Text) (List Text) (Meta (List Unit))) + #let [test-referrals (: (-> Text (List Text) (List Text) (Meta (List Top))) (function (_ module-name all-defs referred-defs) (monad/map Monad - (: (-> Text (Meta Unit)) + (: (-> Text (Meta Top)) (function (_ _def) (if (is-member? all-defs _def) (return []) @@ -4655,10 +4619,10 @@ (-> Text Refer (Meta (List Code))) (do Monad [current-module current-module-name - #let [test-referrals (: (-> Text (List Text) (List Text) (Meta (List Unit))) + #let [test-referrals (: (-> Text (List Text) (List Text) (Meta (List Top))) (function (_ module-name all-defs referred-defs) (monad/map Monad - (: (-> Text (Meta Unit)) + (: (-> Text (Meta Top)) (function (_ _def) (if (is-member? all-defs _def) (return []) @@ -5242,12 +5206,6 @@ (#Primitive name params) (` (#Primitive (~ (text$ name)) (~ (untemplate-list (list/map type-to-code params))))) - #Void - (` #Void) - - #Unit - (` #Unit) - (^template [] ( left right) (` ( (~ (type-to-code left)) (~ (type-to-code right))))) @@ -5277,8 +5235,7 @@ (` (#Apply (~ (type-to-code arg)) (~ (type-to-code fun)))) (#Named [module name] type) - (` (#Named [(~ (text$ module)) (~ (text$ name))] (~ (type-to-code type)))) - )) + (symbol$ [module name]))) (macro: #export (loop tokens) {#.doc (doc "Allows arbitrary looping, using the \"recur\" form to re-start the loop." @@ -5834,7 +5791,7 @@ )) (def: (parse-end tokens) - (-> (List Code) (Meta Unit)) + (-> (List Code) (Meta Top)) (case tokens (^ (list)) (return []) -- cgit v1.2.3