diff options
| author | Eduardo Julian | 2018-05-05 20:42:41 -0400 |
|---|---|---|
| committer | Eduardo Julian | 2018-05-05 20:42:41 -0400 |
| commit | 3c93d7a3aabaa49c67f9a498bc0d70f0af7f09d0 (patch) | |
| tree | 33aea74291323d5084ff70797337150b947962a8 | |
| parent | 88e2aee41d91deed941acc1ef650ccd3dd0334a2 (diff) | |
- Removed Void and Unit as kinds of types.
- Changed the value of "unit" in the old LuxC to match the one in new-luxc.
Diffstat (limited to '')
65 files changed, 534 insertions, 599 deletions
diff --git a/luxc/src/lux/analyser.clj b/luxc/src/lux/analyser.clj index 1202d4faf..5a50be1fa 100644 --- a/luxc/src/lux/analyser.clj +++ b/luxc/src/lux/analyser.clj @@ -201,7 +201,7 @@ ;; [Resources] (defn analyse [optimize eval! compile-module compilers] (|do [asts &parser/parse] - (&/flat-map% (partial analyse-ast optimize eval! compile-module compilers &/$Void) asts))) + (&/flat-map% (partial analyse-ast optimize eval! compile-module compilers &type/Bottom) asts))) (defn clean-output [?var analysis] (|do [:let [[[?output-type ?output-cursor] ?output-term] analysis] diff --git a/luxc/src/lux/analyser/base.clj b/luxc/src/lux/analyser/base.clj index 8c82fe1cf..d0c856ffc 100644 --- a/luxc/src/lux/analyser/base.clj +++ b/luxc/src/lux/analyser/base.clj @@ -74,7 +74,7 @@ (return ?module))] (return (&/T [module* ?name])))) -(let [tag-names #{"Primitive" "Void" "Unit" "Sum" "Product" "Function" "Bound" "Var" "Ex" "UnivQ" "ExQ" "Apply" "Named"}] +(let [tag-names #{"Primitive" "Sum" "Product" "Function" "Bound" "Var" "Ex" "UnivQ" "ExQ" "Apply" "Named"}] (defn type-tag? [module name] (and (= "lux" module) (contains? tag-names name)))) diff --git a/luxc/src/lux/analyser/case.clj b/luxc/src/lux/analyser/case.clj index 434a0f78a..ff00f1aa8 100644 --- a/luxc/src/lux/analyser/case.clj +++ b/luxc/src/lux/analyser/case.clj @@ -38,24 +38,26 @@ (&/T [(&/T ["" -1 -1]) (&/$Tuple &/$Nil)])) (defn ^:private resolve-type [type] - (|case type - (&/$Var ?id) - (|do [type* (&/try-all% (&/|list (&type/deref ?id) - (&/fail-with-loc "##1##")))] - (resolve-type type*)) - - (&/$UnivQ _) - (|do [$var &type/existential - =type (&type/apply-type type $var)] - (&type/actual-type =type)) - - (&/$ExQ _ _) - (|do [$var &type/existential - =type (&type/apply-type type $var)] - (&type/actual-type =type)) + (if (&type/type= &type/Top type) + (return type) + (|case type + (&/$Var ?id) + (|do [type* (&/try-all% (&/|list (&type/deref ?id) + (&/fail-with-loc "##1##")))] + (resolve-type type*)) + + (&/$UnivQ _) + (|do [$var &type/existential + =type (&type/apply-type type $var)] + (&type/actual-type =type)) + + (&/$ExQ _ _) + (|do [$var &type/existential + =type (&type/apply-type type $var)] + (&type/actual-type =type)) - _ - (&type/actual-type type))) + _ + (&type/actual-type type)))) (defn update-up-frame [frame] (|let [[_env _idx _var] frame] @@ -239,9 +241,6 @@ (&/$Named ?name ?type) (adjust-type* up ?type) - (&/$Unit) - (return type) - _ (&/fail-with-loc (str "[Pattern-matching Error] Cannot pattern-match against type: " (&type/show-type type))) )) @@ -302,7 +301,7 @@ (&/$Tuple ?members) (|case ?members (&/$Nil) - (|do [_ (&type/check value-type &/$Unit) + (|do [_ (&type/check value-type &type/Top) =kont kont] (return (&/T [($TupleTestAC (&/|list)) =kont]))) @@ -580,11 +579,8 @@ (|case ?structs (&/$Nil) (|do [value-type* (resolve-type value-type)] - (|case value-type* - (&/$Unit) + (if (&type/type= &type/Top value-type*) (return true) - - _ (&/fail-with-loc "[Pattern-maching Error] Unit is not total."))) _ diff --git a/luxc/src/lux/analyser/lux.clj b/luxc/src/lux/analyser/lux.clj index df5cfb789..efbf68e54 100644 --- a/luxc/src/lux/analyser/lux.clj +++ b/luxc/src/lux/analyser/lux.clj @@ -45,7 +45,7 @@ ;; [Exports] (defn analyse-unit [analyse ?exo-type] (|do [_cursor &/cursor - _ (&type/check ?exo-type &/$Unit)] + _ (&type/check ?exo-type &type/Top)] (return (&/|list (&&/|meta ?exo-type _cursor (&&/$tuple (&/|list))))))) @@ -690,7 +690,7 @@ (return (&/|list (coerce ==type =value))))) (let [input-type (&/$Apply &type/Text &type/List) - output-type (&/$Apply &/$Unit &type/IO)] + output-type (&/$Apply &type/Top &type/IO)] (defn analyse-program [analyse optimize compile-program ?args ?body] (|do [_ &/ensure-statement =body (&/with-scope "" diff --git a/luxc/src/lux/analyser/module.clj b/luxc/src/lux/analyser/module.clj index 8468249ab..fca407c4b 100644 --- a/luxc/src/lux/analyser/module.clj +++ b/luxc/src/lux/analyser/module.clj @@ -48,8 +48,9 @@ )) (do-template [<flagger> <asker> <tag>] - (do (defn <flagger> [module-name] - "(-> Text (Lux Unit))" + (do (defn <flagger> + "(-> Text (Lux Top))" + [module-name] (fn [state] (let [state* (&/update$ &/$modules (fn [modules] @@ -59,8 +60,9 @@ modules)) state)] (&/$Right (&/T [state* &/unit-tag]))))) - (defn <asker> [module-name] + (defn <asker> "(-> Text (Lux Bool))" + [module-name] (fn [state] (if-let [=module (->> state (&/get$ &/$modules) (&/|get module-name))] (&/$Right (&/T [state (|case (&/get$ $module-state =module) @@ -380,7 +382,7 @@ state))))) (defn ensure-can-see-tag - "(-> Text Text (Lux Unit))" + "(-> Text Text (Lux Top))" [module tag-name] (|do [current-module &/get-module-name] (fn [state] @@ -463,8 +465,8 @@ _ (&/fail-with-loc "[Analyser Error] No import meta-data."))) -(def tag-groups - "(Lux (List [Text (List Text)]))" +(def ^{:doc "(Lux (List [Text (List Text)]))"} + tag-groups (|do [module &/get-current-module] (return (&/|map (fn [pair] (|case pair @@ -473,5 +475,4 @@ (|let [[t-prefix t-name] tag] t-name)) tags)]))) - (&/get$ $types module))) - )) + (&/get$ $types module))))) diff --git a/luxc/src/lux/analyser/proc/common.clj b/luxc/src/lux/analyser/proc/common.clj index e3cb5a4c8..94eadb72c 100644 --- a/luxc/src/lux/analyser/proc/common.clj +++ b/luxc/src/lux/analyser/proc/common.clj @@ -289,7 +289,7 @@ ^:private analyse-nat-to-int &type/Nat &type/Int ["nat" "to-int"] ^:private analyse-int-to-nat &type/Int &type/Nat ["int" "to-nat"] - ^:private analyse-nat-char &type/Nat &type/Text ["nat" "char"] + ^:private analyse-nat-char &type/Nat &type/Text ["nat" "char"] ^:private analyse-int-to-frac &type/Int &type/Frac ["int" "to-frac"] ^:private analyse-frac-to-int &type/Frac &type/Int ["frac" "to-int"] @@ -297,7 +297,7 @@ ^:private analyse-deg-to-frac &type/Deg &type/Frac ["deg" "to-frac"] ^:private analyse-frac-to-deg &type/Frac &type/Deg ["frac" "to-deg"] - ^:private analyse-io-log &type/Text &/$Unit ["io" "log"] + ^:private analyse-io-log &type/Text &type/Top ["io" "log"] ^:private analyse-io-error &type/Text &type/Bottom ["io" "error"] ^:private analyse-io-exit &type/Int &type/Bottom ["io" "exit"] ) @@ -459,7 +459,7 @@ (|do [:let [(&/$Cons valueC (&/$Cons boxC (&/$Nil))) ?values] boxA (&&/analyse-1 analyse (&type/Box threadT valueT) boxC) valueA (&&/analyse-1 analyse valueT valueC) - _ (&type/check exo-type &/$Unit) + _ (&type/check exo-type &type/Top) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor (&&/$proc (&/T ["box" "write"]) (&/|list valueA boxA) (&/|list))))))))))) @@ -474,7 +474,7 @@ (defn ^:private analyse-process-future [analyse exo-type ?values] (|do [:let [(&/$Cons ?procedure (&/$Nil)) ?values] =procedure (&&/analyse-1 analyse (&/$Apply &type/Top &type/IO) ?procedure) - _ (&type/check exo-type &/$Unit) + _ (&type/check exo-type &type/Top) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor (&&/$proc (&/T ["process" "future"]) (&/|list =procedure) (&/|list))))))) @@ -483,7 +483,7 @@ (|do [:let [(&/$Cons ?milliseconds (&/$Cons ?procedure (&/$Nil))) ?values] =milliseconds (&&/analyse-1 analyse &type/Nat ?milliseconds) =procedure (&&/analyse-1 analyse (&/$Apply &type/Top &type/IO) ?procedure) - _ (&type/check exo-type &/$Unit) + _ (&type/check exo-type &type/Top) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor (&&/$proc (&/T ["process" "schedule"]) (&/|list =milliseconds =procedure) (&/|list))))))) diff --git a/luxc/src/lux/analyser/proc/jvm.clj b/luxc/src/lux/analyser/proc/jvm.clj index 8d926f437..2eef1082c 100644 --- a/luxc/src/lux/analyser/proc/jvm.clj +++ b/luxc/src/lux/analyser/proc/jvm.clj @@ -194,7 +194,7 @@ "float" (return (&/$Primitive "java.lang.Float" &/$Nil)) "double" (return (&/$Primitive "java.lang.Double" &/$Nil)) "char" (return (&/$Primitive "java.lang.Character" &/$Nil)) - "void" (return &/$Unit) + "void" (return &type/Top) ;; else (|do [=params (&/map% (partial generic-class->type env) params)] (return (&/$Primitive name =params)))) @@ -252,7 +252,7 @@ itype (generic-class->type full-env itype*)] (if (double-register-gclass? itype*) (&&env/with-local iname itype - (&&env/with-local "" &/$Void + (&&env/with-local "" &type/Bottom body*)) (&&env/with-local iname itype body*))))) @@ -265,7 +265,7 @@ (&/$ConstructorMethodSyntax =privacy-modifier ?strict ?anns ?gvars ?exceptions ?inputs ?ctor-args ?body) (|do [method-env (make-type-env ?gvars) :let [full-env (&/|++ class-env method-env)] - :let [output-type &/$Unit] + :let [output-type &type/Top] =ctor-args (&/map% (fn [ctor-arg] (|do [:let [[ca-type ca-term] ctor-arg] =ca-type (generic-class->type full-env ca-type) @@ -673,7 +673,7 @@ :let [gclass (&host-type/gtype->gclass gtype)] =type (&host-type/instance-param &type/existential &/$Nil gtype) =value (&&/analyse-1 analyse =type value) - :let [output-type &/$Unit] + :let [output-type &type/Top] _ (&type/check exo-type output-type) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor @@ -690,7 +690,7 @@ :let [gclass (&host-type/gtype->gclass gtype)] =type (analyse-field-access-helper obj-type gvars gtype) =value (&&/analyse-1 analyse =type value) - :let [output-type &/$Unit] + :let [output-type &type/Top] _ (&type/check exo-type output-type) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor @@ -829,7 +829,7 @@ _ (compile-interface interface-decl supers =anns =methods) :let [_ (println 'INTERFACE (str module "." (&/|first interface-decl)))] _cursor &/cursor] - (return (&/|list (&&/|meta &/$Unit _cursor + (return (&/|list (&&/|meta &type/Top _cursor (&&/$tuple (&/|list))))))) (defn ^:private analyse-jvm-class [analyse compile-class class-decl super-class interfaces =inheritance-modifier =anns ?fields methods] @@ -848,7 +848,7 @@ _ &/pop-dummy-name :let [_ (println 'CLASS full-name)] _cursor &/cursor] - (return (&/|list (&&/|meta &/$Unit _cursor + (return (&/|list (&&/|meta &type/Top _cursor (&&/$tuple (&/|list)))))))) (defn ^:private captured-source [env-entry] diff --git a/luxc/src/lux/analyser/record.clj b/luxc/src/lux/analyser/record.clj index ac9a0e64d..595858873 100644 --- a/luxc/src/lux/analyser/record.clj +++ b/luxc/src/lux/analyser/record.clj @@ -11,7 +11,7 @@ "(-> (List (, Syntax Syntax)) (Lux (List Syntax)))" (|do [[tag-group tag-type] (|case pairs (&/$Nil) - (return (&/T [&/$Nil &/$Unit])) + (return (&/T [&/$Nil &type/Top])) (&/$Cons [[_ (&/$Tag tag1)] _] _) (|do [[module name] (&&/resolved-ident tag1) diff --git a/luxc/src/lux/base.clj b/luxc/src/lux/base.clj index 02942f4e0..25c331b94 100644 --- a/luxc/src/lux/base.clj +++ b/luxc/src/lux/base.clj @@ -10,7 +10,7 @@ (apply prn args))) ;; [Tags] -(def unit-tag (.intern (str (char 0) "unit" (char 0)))) +(def unit-tag (.intern "")) (defn T [elems] (case (count elems) @@ -86,8 +86,6 @@ ;; Type (defvariant ("Primitive" 2) - ("Void" 0) - ("Unit" 0) ("Sum" 2) ("Product" 2) ("Function" 2) @@ -413,8 +411,9 @@ _ (assert false (prn-str '|map f (adt->text xs))))) -(defn |empty? [xs] +(defn |empty? "(All [a] (-> (List a) Bool))" + [xs] (|case xs ($Nil) true @@ -422,8 +421,9 @@ ($Cons _ _) false)) -(defn |filter [p xs] +(defn |filter "(All [a] (-> (-> a Bool) (List a) (List a)))" + [p xs] (|case xs ($Nil) xs @@ -433,8 +433,9 @@ ($Cons x (|filter p xs*)) (|filter p xs*)))) -(defn flat-map [f xs] +(defn flat-map "(All [a b] (-> (-> a (List b)) (List a) (List b)))" + [f xs] (|case xs ($Nil) xs @@ -656,8 +657,9 @@ (return* state unit-tag) (fail* msg))))) -(defn |some [f xs] +(defn |some "(All [a b] (-> (-> a (Maybe b)) (List a) (Maybe b)))" + [f xs] (|case xs ($Nil) $None @@ -782,8 +784,9 @@ (defn with-writer [writer body] (with-jvm-host-slot $writer (fn [_] ($Some writer)) body)) -(defn with-type-env [type-env body] +(defn with-type-env "(All [a] (-> TypeEnv (Lux a) (Lux a)))" + [type-env body] (with-jvm-host-slot $type-env (partial |++ type-env) body)) (defn push-dummy-name [real-name store-name] @@ -853,17 +856,17 @@ ($Left msg) (fail* msg)))) -(defn in-eval? [mode] - "(-> CompilerMode Bool)" - (|case mode - ($Eval) true - _ false)) +(do-template [<name> <tag>] + (defn <name> + "(-> CompilerMode Bool)" + [mode] + (|case mode + (<tag>) true + _ false)) -(defn in-repl? [mode] - "(-> CompilerMode Bool)" - (|case mode - ($REPL) true - _ false)) + in-eval? $Eval + in-repl? $REPL + ) (defn with-eval [body] (fn [state] @@ -924,16 +927,17 @@ ($Some module-name) (return* state module-name)))) -(defn find-module [name] +(defn find-module "(-> Text (Lux (Module Compiler)))" + [name] (fn [state] (if-let [module (|get name (get$ $modules state))] (return* state module) ((fail-with-loc (str "[Error] Unknown module: " name)) state)))) -(def get-current-module - "(Lux (Module Compiler))" +(def ^{:doc "(Lux (Module Compiler))"} + get-current-module (|do [module-name get-module-name] (find-module module-name))) @@ -1009,8 +1013,9 @@ _ output))))) -(defn with-expected-type [type body] +(defn with-expected-type "(All [a] (-> Type (Lux a)))" + [type body] (fn [state] (let [output (body (set$ $expected ($Some type) state))] (|case output @@ -1021,8 +1026,9 @@ _ output)))) -(defn with-cursor [^objects cursor body] +(defn with-cursor "(All [a] (-> Cursor (Lux a)))" + [^objects cursor body] (|let [[_file-name _ _] cursor] (if (= "" _file-name) body @@ -1036,8 +1042,9 @@ _ output)))))) -(defn with-analysis-meta [^objects cursor type body] +(defn with-analysis-meta "(All [a] (-> Cursor Type (Lux a)))" + [^objects cursor type body] (|let [[_file-name _ _] cursor] (if (= "" _file-name) (fn [state] @@ -1065,8 +1072,8 @@ _ output)))))) -(def ensure-statement - "(Lux Unit)" +(def ^{:doc "(Lux Top)"} + ensure-statement (fn [state] (|case (get$ $expected state) ($None) @@ -1297,8 +1304,9 @@ ;; (assert false) )) -(defn ^:private enumerate* [idx xs] +(defn ^:private enumerate* "(All [a] (-> Int (List a) (List (, Int a))))" + [idx xs] (|case xs ($Cons x xs*) ($Cons (T [idx x]) @@ -1308,23 +1316,26 @@ xs )) -(defn enumerate [xs] +(defn enumerate "(All [a] (-> (List a) (List (, Int a))))" + [xs] (enumerate* 0 xs)) -(def modules - "(Lux (List Text))" +(def ^{:doc "(Lux (List Text))"} + modules (fn [state] (return* state (|keys (get$ $modules state))))) -(defn when% [test body] - "(-> Bool (Lux Unit) (Lux Unit))" +(defn when% + "(-> Bool (Lux Top) (Lux Top))" + [test body] (if test body (return unit-tag))) -(defn |at [idx xs] +(defn |at "(All [a] (-> Int (List a) (Maybe a)))" + [idx xs] (|case xs ($Cons x xs*) (cond (< idx 0) @@ -1337,11 +1348,11 @@ (|at (dec idx) xs*)) ($Nil) - $None - )) + $None)) -(defn normalize [ident] +(defn normalize "(-> Ident (Lux Ident))" + [ident] (|case ident ["" name] (|do [module get-module-name] (return (T [module name]))) @@ -1367,8 +1378,9 @@ ))) (do-template [<name> <default> <op>] - (defn <name> [p xs] + (defn <name> "(All [a] (-> (-> a Bool) (List a) Bool))" + [p xs] (|case xs ($Nil) <default> @@ -1379,14 +1391,16 @@ |every? true and |any? false or) -(defn m-comp [f g] +(defn m-comp "(All [a b c] (-> (-> b (Lux c)) (-> a (Lux b)) (-> a (Lux c))))" + [f g] (fn [x] (|do [y (g x)] (f y)))) -(defn with-attempt [m-value on-error] +(defn with-attempt "(All [a] (-> (Lux a) (-> Text (Lux a)) (Lux a)))" + [m-value on-error] (fn [state] (|case (m-value state) ($Left msg) diff --git a/luxc/src/lux/compiler/cache/type.clj b/luxc/src/lux/compiler/cache/type.clj index 76cdbec52..338673807 100644 --- a/luxc/src/lux/compiler/cache/type.clj +++ b/luxc/src/lux/compiler/cache/type.clj @@ -26,12 +26,6 @@ (&/$Primitive name params) (str "^" name stop (serialize-list serialize-type params)) - (&/$Void) - "0" - - (&/$Unit) - "1" - (&/$Product left right) (str "*" (serialize-type left) (serialize-type right)) @@ -78,16 +72,9 @@ [(&/$Cons head tail) input*])) )) -(do-template [<name> <signal> <type>] - (defn <name> [^String input] - (when (.startsWith input <signal>) - [<type> (.substring input 1)] - )) - - ^:private deserialize-void "0" &/$Void - ^:private deserialize-unit "1" &/$Unit - ^:private deserialize-type* "T" &type/Type - ) +(defn ^:private deserialize-type* [^String input] + (when (.startsWith input "T") + [&type/Type (.substring input 1)])) (do-template [<name> <signal> <type>] (defn <name> [^String input] @@ -142,8 +129,6 @@ "(-> Text Type)" [input] (or (deserialize-type* input) - (deserialize-void input) - (deserialize-unit input) (deserialize-sum input) (deserialize-prod input) (deserialize-lambda input) diff --git a/luxc/src/lux/compiler/jvm/proc/host.clj b/luxc/src/lux/compiler/jvm/proc/host.clj index 041e72819..da2c5ccde 100644 --- a/luxc/src/lux/compiler/jvm/proc/host.clj +++ b/luxc/src/lux/compiler/jvm/proc/host.clj @@ -47,45 +47,44 @@ double-class "java.lang.Double" char-class "java.lang.Character"] (defn prepare-return! [^MethodVisitor *writer* *type*] - (|case *type* - (&/$Unit) + (if (&type/type= &type/Top *type*) (.visitLdcInsn *writer* &/unit-tag) + (|case *type* + (&/$Primitive "boolean" (&/$Nil)) + (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host-generics/->bytecode-class-name boolean-class) "valueOf" (str "(Z)" (&host-generics/->type-signature boolean-class))) + + (&/$Primitive "byte" (&/$Nil)) + (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host-generics/->bytecode-class-name byte-class) "valueOf" (str "(B)" (&host-generics/->type-signature byte-class))) - (&/$Primitive "boolean" (&/$Nil)) - (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host-generics/->bytecode-class-name boolean-class) "valueOf" (str "(Z)" (&host-generics/->type-signature boolean-class))) - - (&/$Primitive "byte" (&/$Nil)) - (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host-generics/->bytecode-class-name byte-class) "valueOf" (str "(B)" (&host-generics/->type-signature byte-class))) + (&/$Primitive "short" (&/$Nil)) + (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host-generics/->bytecode-class-name short-class) "valueOf" (str "(S)" (&host-generics/->type-signature short-class))) - (&/$Primitive "short" (&/$Nil)) - (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host-generics/->bytecode-class-name short-class) "valueOf" (str "(S)" (&host-generics/->type-signature short-class))) + (&/$Primitive "int" (&/$Nil)) + (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host-generics/->bytecode-class-name int-class) "valueOf" (str "(I)" (&host-generics/->type-signature int-class))) - (&/$Primitive "int" (&/$Nil)) - (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host-generics/->bytecode-class-name int-class) "valueOf" (str "(I)" (&host-generics/->type-signature int-class))) + (&/$Primitive "long" (&/$Nil)) + (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host-generics/->bytecode-class-name long-class) "valueOf" (str "(J)" (&host-generics/->type-signature long-class))) - (&/$Primitive "long" (&/$Nil)) - (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host-generics/->bytecode-class-name long-class) "valueOf" (str "(J)" (&host-generics/->type-signature long-class))) + (&/$Primitive "float" (&/$Nil)) + (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host-generics/->bytecode-class-name float-class) "valueOf" (str "(F)" (&host-generics/->type-signature float-class))) - (&/$Primitive "float" (&/$Nil)) - (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host-generics/->bytecode-class-name float-class) "valueOf" (str "(F)" (&host-generics/->type-signature float-class))) + (&/$Primitive "double" (&/$Nil)) + (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host-generics/->bytecode-class-name double-class) "valueOf" (str "(D)" (&host-generics/->type-signature double-class))) - (&/$Primitive "double" (&/$Nil)) - (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host-generics/->bytecode-class-name double-class) "valueOf" (str "(D)" (&host-generics/->type-signature double-class))) + (&/$Primitive "char" (&/$Nil)) + (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host-generics/->bytecode-class-name char-class) "valueOf" (str "(C)" (&host-generics/->type-signature char-class))) + + (&/$Primitive _ _) + nil - (&/$Primitive "char" (&/$Nil)) - (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host-generics/->bytecode-class-name char-class) "valueOf" (str "(C)" (&host-generics/->type-signature char-class))) - - (&/$Primitive _ _) - nil + (&/$Named ?name ?type) + (prepare-return! *writer* ?type) - (&/$Named ?name ?type) - (prepare-return! *writer* ?type) + (&/$Ex _) + nil - (&/$Ex _) - nil - - _ - (assert false (str 'prepare-return! " " (&type/show-type *type*)))) + _ + (assert false (str 'prepare-return! " " (&type/show-type *type*))))) *writer*)) ;; [Resources] diff --git a/luxc/src/lux/host.clj b/luxc/src/lux/host.clj index 97d2bd69d..3f0181c99 100644 --- a/luxc/src/lux/host.clj +++ b/luxc/src/lux/host.clj @@ -58,9 +58,6 @@ (&/$Function _ _) (return (&host-generics/->type-signature function-class)) - (&/$Unit) - (return "V") - (&/$Sum _) (return object-array) @@ -78,7 +75,9 @@ (return ex-type-class) _ - (assert false (str '->java-sig " " (&type/show-type type))) + (if (&type/type= &type/Top type) + (return "V") + (assert false (str '->java-sig " " (&type/show-type type)))) ))) (do-template [<name> <static?>] diff --git a/luxc/src/lux/type.clj b/luxc/src/lux/type.clj index 76d580cb0..b9c5898a7 100644 --- a/luxc/src/lux/type.clj +++ b/luxc/src/lux/type.clj @@ -59,14 +59,14 @@ (def IO (&/$Named (&/T ["lux/codata" "IO"]) (&/$UnivQ empty-env - (&/$Function &/$Void (&/$Bound 1))))) + (&/$Function Bottom (&/$Bound 1))))) (def List (&/$Named (&/T ["lux" "List"]) (&/$UnivQ empty-env (&/$Sum ;; lux;Nil - &/$Unit + Top ;; lux;Cons (&/$Product (&/$Bound 1) (&/$Apply (&/$Bound 1) @@ -77,7 +77,7 @@ (&/$UnivQ empty-env (&/$Sum ;; lux;None - &/$Unit + Top ;; lux;Some (&/$Bound 1)) ))) @@ -87,46 +87,40 @@ (let [Type (&/$Apply (&/$Bound 1) (&/$Bound 0)) TypeList (&/$Apply Type List) TypePair (&/$Product Type Type)] - (&/$Apply &/$Void + (&/$Apply Bottom (&/$UnivQ empty-env (&/$Sum ;; Primitive (&/$Product Text TypeList) (&/$Sum - ;; Void - &/$Unit + ;; Sum + TypePair (&/$Sum - ;; Unit - &/$Unit + ;; Product + TypePair (&/$Sum - ;; Sum + ;; Function TypePair (&/$Sum - ;; Product - TypePair + ;; Bound + Nat (&/$Sum - ;; Function - TypePair + ;; Var + Nat (&/$Sum - ;; Bound + ;; Ex Nat (&/$Sum - ;; Var - Nat + ;; UnivQ + (&/$Product TypeList Type) (&/$Sum - ;; Ex - Nat + ;; ExQ + (&/$Product TypeList Type) (&/$Sum - ;; UnivQ - (&/$Product TypeList Type) - (&/$Sum - ;; ExQ - (&/$Product TypeList Type) - (&/$Sum - ;; App - TypePair - ;; Named - (&/$Product Ident Type))))))))))))) + ;; App + TypePair + ;; Named + (&/$Product Ident Type))))))))))) ))))) (def Cursor @@ -423,8 +417,8 @@ (&/$Nil) <unit>)) - Variant$ &/$Sum &/$Void - Tuple$ &/$Product &/$Unit + Variant$ &/$Sum Bottom + Tuple$ &/$Product Top ) (defn show-type [^objects type] @@ -437,12 +431,6 @@ _ (str "(primitive " (pr-str name) " " (->> params (&/|map show-type) (&/|interpose " ") (&/fold str "")) ")")) - (&/$Void) - "Void" - - (&/$Unit) - "Unit" - (&/$Product _) (str "[" (->> (flatten-prod type) (&/|map show-type) (&/|interpose " ") (&/fold str "")) "]") @@ -492,12 +480,6 @@ (= (&/|length xparams) (&/|length yparams)) (&/fold2 #(and %1 (type= %2 %3)) true xparams yparams)) - [(&/$Void) (&/$Void)] - true - - [(&/$Unit) (&/$Unit)] - true - [(&/$Product xL xR) (&/$Product yL yR)] (and (type= xL yL) (type= xR yR)) @@ -834,12 +816,6 @@ (return fixpoints)) (check-error "" expected actual))))) - [(&/$Void) (&/$Void)] - (return fixpoints) - - [(&/$Unit) (&/$Unit)] - (return fixpoints) - [(&/$Function eI eO) (&/$Function aI aO)] (|do [fixpoints* (check* fixpoints invariant?? aI eI)] (check* fixpoints* invariant?? eO aO)) @@ -947,8 +923,8 @@ (&/$Cons last prevs) (&/fold (fn [r l] (<plus> l r)) last prevs))) - fold-prod &/$Unit &/$Product - fold-sum &/$Void &/$Sum + fold-prod Top &/$Product + fold-sum Bottom &/$Sum ) (def create-var+ diff --git a/luxc/src/lux/type/host.clj b/luxc/src/lux/type/host.clj index c4d4ef243..2e2db3bf6 100644 --- a/luxc/src/lux/type/host.clj +++ b/luxc/src/lux/type/host.clj @@ -8,6 +8,61 @@ TypeVariable WildcardType))) +(defn ^:private type= [x y] + (or (clojure.lang.Util/identical x y) + (let [output (|case [x y] + [(&/$Named [?xmodule ?xname] ?xtype) (&/$Named [?ymodule ?yname] ?ytype)] + (and (= ?xmodule ?ymodule) + (= ?xname ?yname)) + + [(&/$Primitive xname xparams) (&/$Primitive yname yparams)] + (and (.equals ^Object xname yname) + (= (&/|length xparams) (&/|length yparams)) + (&/fold2 #(and %1 (type= %2 %3)) true xparams yparams)) + + [(&/$Product xL xR) (&/$Product yL yR)] + (and (type= xL yL) + (type= xR yR)) + + [(&/$Sum xL xR) (&/$Sum yL yR)] + (and (type= xL yL) + (type= xR yR)) + + [(&/$Function xinput xoutput) (&/$Function yinput youtput)] + (and (type= xinput yinput) + (type= xoutput youtput)) + + [(&/$Var xid) (&/$Var yid)] + (= xid yid) + + [(&/$Bound xidx) (&/$Bound yidx)] + (= xidx yidx) + + [(&/$Ex xid) (&/$Ex yid)] + (= xid yid) + + [(&/$Apply xparam xlambda) (&/$Apply yparam ylambda)] + (and (type= xparam yparam) (type= xlambda ylambda)) + + [(&/$UnivQ xenv xbody) (&/$UnivQ yenv ybody)] + (type= xbody ybody) + + [(&/$Named ?xname ?xtype) _] + (type= ?xtype y) + + [_ (&/$Named ?yname ?ytype)] + (type= x ?ytype) + + [_ _] + false + )] + output))) + +(def ^:private Top + (&/$Named (&/T ["lux" "Top"]) + (&/$ExQ (&/|list) + (&/$Bound 1)))) + ;; [Exports] (def array-data-tag "#Array") (def null-data-tag "#Null") @@ -82,7 +137,7 @@ (if-let [[_ _ arr-obrackets arr-obase simple-base arr-pbrackets arr-pbase] (re-find class-name-re gclass-name)] (let [base (or arr-obase simple-base (jprim->lprim arr-pbase))] (if (.equals "void" base) - &/$Unit + Top (reduce (fn [inner _] (&/$Primitive array-data-tag (&/|list inner))) (&/$Primitive base (try (-> (Class/forName base) .getTypeParameters seq count (repeat (&/$Primitive "java.lang.Object" &/$Nil)) @@ -126,15 +181,15 @@ (defn principal-class [refl-type] (cond (instance? Class refl-type) - (|case (class->type refl-type) - (&/$Primitive "#Array" (&/$Cons (&/$Primitive class-name _) (&/$Nil))) - (str "[" (&host-generics/->type-signature class-name)) - - (&/$Primitive class-name _) - (&host-generics/->type-signature class-name) - - (&/$Unit) - "V") + (let [class-type (class->type refl-type)] + (if (type= Top class-type) + "V" + (|case class-type + (&/$Primitive "#Array" (&/$Cons (&/$Primitive class-name _) (&/$Nil))) + (str "[" (&host-generics/->type-signature class-name)) + + (&/$Primitive class-name _) + (&host-generics/->type-signature class-name)))) (instance? GenericArrayType refl-type) (str "[" (principal-class (.getGenericComponentType ^GenericArrayType refl-type))) 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<Meta> - (: (-> 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<Meta> [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<Meta> - (: (-> 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 [<tag>] (<tag> left right) (` (<tag> (~ (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 []) diff --git a/stdlib/source/lux/cli.lux b/stdlib/source/lux/cli.lux index 7a88b84f8..466895876 100644 --- a/stdlib/source/lux/cli.lux +++ b/stdlib/source/lux/cli.lux @@ -53,7 +53,7 @@ (def: #export (this reference) {#.doc "Checks that a token is in the inputs."} - (-> Text (CLI Unit)) + (-> Text (CLI Top)) (function (_ inputs) (do E.Monad<Error> [[remaining raw] (any inputs)] @@ -83,7 +83,7 @@ (def: #export end {#.doc "Ensures there are no more inputs."} - (CLI Unit) + (CLI Top) (function (_ inputs) (case inputs #.Nil (#E.Success [inputs []]) @@ -130,7 +130,7 @@ (#Parsed args) (with-gensyms [g!args g!_ g!output g!message] (wrap (list (` ("lux program" (~ g!args) - (case ((: (~! (..CLI (io.IO Unit))) + (case ((: (~! (..CLI (io.IO .Top))) ((~! do) (~! p.Monad<Parser>) [(~+ (|> args (list/map (function (_ [binding parser]) diff --git a/stdlib/source/lux/concurrency/actor.lux b/stdlib/source/lux/concurrency/actor.lux index 0e85758ed..4fdb2c207 100644 --- a/stdlib/source/lux/concurrency/actor.lux +++ b/stdlib/source/lux/concurrency/actor.lux @@ -61,7 +61,7 @@ (type: #export (Behavior s) {#.doc "An actor's behavior when messages are received."} {#handle (-> (Message s) s (Actor s) (Task s)) - #end (-> Text s (Promise Unit))}) + #end (-> Text s (Promise Top))}) (def: #export (spawn behavior init) {#.doc "Given a behavior and initial state, spawns an actor and returns it."} @@ -124,7 +124,7 @@ (message state self)) (def: (default-end cause state) - (All [s] (-> Text s (Promise Unit))) + (All [s] (-> Text s (Promise Top))) (promise/wrap [])) (def: #export default-behavior diff --git a/stdlib/source/lux/concurrency/frp.lux b/stdlib/source/lux/concurrency/frp.lux index e160fec12..caa1173c2 100644 --- a/stdlib/source/lux/concurrency/frp.lux +++ b/stdlib/source/lux/concurrency/frp.lux @@ -76,7 +76,7 @@ output))) (def: #export (periodic time) - (-> Nat (Channel Unit)) + (-> Nat (Channel Top)) (let [output (channel [])] (exec (io.run (loop [_ []] diff --git a/stdlib/source/lux/concurrency/promise.lux b/stdlib/source/lux/concurrency/promise.lux index 0e3e0c695..63305f318 100644 --- a/stdlib/source/lux/concurrency/promise.lux +++ b/stdlib/source/lux/concurrency/promise.lux @@ -149,8 +149,8 @@ (def: #export (wait time) {#.doc "Returns a promise that will be resolved after the specified amount of milliseconds."} - (-> Nat (Promise Unit)) - (let [!out (: (Promise Unit) (promise #.None))] + (-> Nat (Promise Top)) + (let [!out (: (Promise Top) (promise #.None))] (exec ("lux process schedule" time (resolve [] !out)) !out))) diff --git a/stdlib/source/lux/concurrency/semaphore.lux b/stdlib/source/lux/concurrency/semaphore.lux index c4391fbc9..50a1a621c 100644 --- a/stdlib/source/lux/concurrency/semaphore.lux +++ b/stdlib/source/lux/concurrency/semaphore.lux @@ -9,7 +9,7 @@ (type: State {#open-positions Nat - #waiting-list (List (Promise Unit))}) + #waiting-list (List (Promise Top))}) (abstract: #export Semaphore {#.doc "A tool for controlling access to resources by multiple concurrent processes."} @@ -22,10 +22,10 @@ #waiting-list (list)}))) (def: #export (wait semaphore) - (Ex [k] (-> Semaphore (Promise Unit))) + (Ex [k] (-> Semaphore (Promise Top))) (let [semaphore (@representation semaphore)] (io.run - (loop [signal (: (Promise Unit) + (loop [signal (: (Promise Top) (promise.promise #.None))] (do io.Monad<IO> [state (atom.read semaphore) @@ -44,13 +44,13 @@ (recur signal))))))) (def: #export (signal semaphore) - (Ex [k] (-> Semaphore (Promise Unit))) + (Ex [k] (-> Semaphore (Promise Top))) (let [semaphore (@representation semaphore)] (promise.future (loop [_ []] (do io.Monad<IO> [state (atom.read semaphore) - #let [[?signal state'] (: [(Maybe (Promise Unit)) State] + #let [[?signal state'] (: [(Maybe (Promise Top)) State] (case (get@ #waiting-list state) #.Nil [#.None (update@ #open-positions n/inc state)] @@ -80,11 +80,11 @@ (@abstraction (semaphore +1))) (def: (acquire mutex) - (-> Mutex (Promise Unit)) + (-> Mutex (Promise Top)) (wait (@representation mutex))) (def: (release mutex) - (-> Mutex (Promise Unit)) + (-> Mutex (Promise Top)) (signal (@representation mutex))) (def: #export (synchronize mutex procedure) @@ -125,7 +125,7 @@ (do-template [<phase> <update> <goal> <turnstile>] [(def: (<phase> (^@representation barrier)) - (-> Barrier (Promise Unit)) + (-> Barrier (Promise Top)) (do promise.Monad<Promise> [#let [limit (refinement.un-refine (get@ #limit barrier)) goal <goal> @@ -140,7 +140,7 @@ ) (def: #export (block barrier) - (-> Barrier (Promise Unit)) + (-> Barrier (Promise Top)) (do promise.Monad<Promise> [_ (start barrier)] (end barrier))) diff --git a/stdlib/source/lux/concurrency/stm.lux b/stdlib/source/lux/concurrency/stm.lux index 707512821..fb150d842 100644 --- a/stdlib/source/lux/concurrency/stm.lux +++ b/stdlib/source/lux/concurrency/stm.lux @@ -34,7 +34,7 @@ (:: io.Functor<IO> map product.left))) (def: (write! new-value (^@representation var)) - (All [a] (-> a (Var a) (IO Unit))) + (All [a] (-> a (Var a) (IO Top))) (do io.Monad<IO> [(^@ old [_value _observers]) (atom.read var) succeeded? (atom.compare-and-swap old [new-value _observers] var)] @@ -76,8 +76,8 @@ (All [a] (-> (Var a) Tx (Maybe a))) (|> tx (list.find (function (_ [_var _original _current]) - (is? (:! (Var Unit) var) - (:! (Var Unit) _var)))) + (is? (:! (Var Top) var) + (:! (Var Top) _var)))) (:: maybe.Monad<Maybe> map (function (_ [_var _original _current]) _current)) (:!!) @@ -102,11 +102,11 @@ #.Nil (#.Cons [_var _original _current] tx') - (if (is? (:! (Var Unit) var) - (:! (Var Unit) _var)) - (#.Cons {#var (:! (Var Unit) _var) - #original (:! Unit _original) - #current (:! Unit value)} + (if (is? (:! (Var Top) var) + (:! (Var Top) _var)) + (#.Cons {#var (:! (Var Top) _var) + #original (:! Top _original) + #current (:! Top value)} tx') (#.Cons {#var _var #original _original @@ -116,7 +116,7 @@ (def: #export (write value var) {#.doc "Writes value to var."} - (All [a] (-> a (Var a) (STM Unit))) + (All [a] (-> a (Var a) (STM Top))) (function (_ tx) (case (find-var-value var tx) (#.Some _) @@ -169,7 +169,7 @@ tx)) (def: (commit-var! [_var _original _current]) - (-> (Ex [a] (Tx-Frame a)) Unit) + (-> (Ex [a] (Tx-Frame a)) Top) (if (is? _original _current) [] (io.run (write! _current _var)))) @@ -202,7 +202,7 @@ (recur tail))))) (def: (process-commit [stm-proc output]) - (-> [(STM Unit) (Promise Unit)] Top) + (-> [(STM Top) (Promise Top)] Top) (let [[finished-tx value] (stm-proc fresh-tx)] (io.run (if (can-commit? finished-tx) (exec (list/map commit-var! finished-tx) @@ -210,7 +210,7 @@ (issue-commit [stm-proc output]))))) (def: init-processor! - (IO Unit) + (IO Top) (do io.Monad<IO> [flag (atom.read commit-processor-flag)] (if flag @@ -220,7 +220,7 @@ (if was-first? (exec (|> (io.run (atom.read pending-commits)) (promise.await (function (recur [head tail]) - (io (exec (process-commit (:! [(STM Unit) (Promise Unit)] head)) + (io (exec (process-commit (:! [(STM Top) (Promise Top)] head)) (promise.await recur tail)))))) (wrap [])) (wrap []))) diff --git a/stdlib/source/lux/concurrency/task.lux b/stdlib/source/lux/concurrency/task.lux index 66cc12ff3..8d95842e9 100644 --- a/stdlib/source/lux/concurrency/task.lux +++ b/stdlib/source/lux/concurrency/task.lux @@ -70,8 +70,8 @@ ma)))) (syntax: #export (task {type s.any}) - {#.doc (doc "Makes an uninitialized Task (in this example, of Unit)." - (task Unit))} + {#.doc (doc "Makes an uninitialized Task (in this example, of Top)." + (task Top))} (wrap (list (` (: (..Task (~ type)) (P.promise #.None)))))) diff --git a/stdlib/source/lux/control/concatenative.lux b/stdlib/source/lux/control/concatenative.lux index ee342ec22..1af41bbdb 100644 --- a/stdlib/source/lux/control/concatenative.lux +++ b/stdlib/source/lux/control/concatenative.lux @@ -86,10 +86,10 @@ (-> (~ (de-alias inputC)) (~ (de-alias outputC)))))))))))) -(def: begin! Unit []) +(def: begin! Top []) (def: end! - (All [a] (-> [Unit a] a)) + (All [a] (-> [Top a] a)) (function (_ [_ top]) top)) diff --git a/stdlib/source/lux/control/parser.lux b/stdlib/source/lux/control/parser.lux index d46b166e4..3c1022fc8 100644 --- a/stdlib/source/lux/control/parser.lux +++ b/stdlib/source/lux/control/parser.lux @@ -59,7 +59,7 @@ ## [Parsers] (def: #export (assert message test) {#.doc "Fails with the given message if the test is false."} - (All [s] (-> Text Bool (Parser s Unit))) + (All [s] (-> Text Bool (Parser s Top))) (function (_ input) (if test (#e.Success [input []]) @@ -192,7 +192,7 @@ ))) (def: #export (not p) - (All [s a] (-> (Parser s a) (Parser s Unit))) + (All [s a] (-> (Parser s a) (Parser s Top))) (function (_ input) (case (p input) (#e.Error msg) diff --git a/stdlib/source/lux/control/pipe.lux b/stdlib/source/lux/control/pipe.lux index 7e55fc447..4e84e7832 100644 --- a/stdlib/source/lux/control/pipe.lux +++ b/stdlib/source/lux/control/pipe.lux @@ -35,7 +35,7 @@ (~ body)))))) (def: _reverse_ - (Syntax Unit) + (Syntax Top) (function (_ tokens) (#e.Success [(list.reverse tokens) []]))) diff --git a/stdlib/source/lux/control/region.lux b/stdlib/source/lux/control/region.lux index f21076ad0..e26a23ab9 100644 --- a/stdlib/source/lux/control/region.lux +++ b/stdlib/source/lux/control/region.lux @@ -9,7 +9,7 @@ (coll [list "list/" Fold<List>])))) (type: (Cleaner r m) - (-> r (m (Error Unit)))) + (-> r (m (Error Top)))) (type: #export (Region r m a) (-> [r (List (Cleaner r m))] @@ -36,7 +36,7 @@ error|output)))) (def: (combine-outcomes clean-up output) - (All [a] (-> (Error Unit) (Error a) (Error a))) + (All [a] (-> (Error Top) (Error a) (Error a))) (case clean-up (#e.Success _) output @@ -55,7 +55,7 @@ (wrap (list/fold combine-outcomes output results)))) (def: #export (acquire Monad<m> cleaner value) - (All [m a] (-> (Monad m) (-> a (m (Error Unit))) a + (All [m a] (-> (Monad m) (-> a (m (Error Top))) a (All [r] (Region r m a)))) (function (_ [region cleaners]) (:: Monad<m> wrap [(#.Cons (function (_ region) (cleaner value)) diff --git a/stdlib/source/lux/control/state.lux b/stdlib/source/lux/control/state.lux index 422cf4fc6..ab69ed9fe 100644 --- a/stdlib/source/lux/control/state.lux +++ b/stdlib/source/lux/control/state.lux @@ -52,13 +52,13 @@ (def: #export (put new-state) {#.doc "Set the new state."} - (All [s] (-> s (State s Unit))) + (All [s] (-> s (State s Top))) (function (_ state) [new-state []])) (def: #export (update change) {#.doc "Compute the new state."} - (All [s] (-> (-> s s) (State s Unit))) + (All [s] (-> (-> s s) (State s Top))) (function (_ state) [(change state) []])) @@ -134,7 +134,7 @@ (wrap [state a])))) (def: #export (while condition body) - (All [s] (-> (State s Bool) (State s Unit) (State s Unit))) + (All [s] (-> (State s Bool) (State s Top) (State s Top))) (do Monad<State> [execute? condition] (if execute? @@ -144,7 +144,7 @@ (wrap [])))) (def: #export (do-while condition body) - (All [s] (-> (State s Bool) (State s Unit) (State s Unit))) + (All [s] (-> (State s Bool) (State s Top) (State s Top))) (do Monad<State> [_ body] (while condition body))) diff --git a/stdlib/source/lux/control/thread.lux b/stdlib/source/lux/control/thread.lux index d79cc0d10..e44869043 100644 --- a/stdlib/source/lux/control/thread.lux +++ b/stdlib/source/lux/control/thread.lux @@ -23,7 +23,7 @@ ("lux box read" box))) (def: #export (write value box) - (All [a] (-> a (All [!] (-> (Box ! a) (Thread ! Unit))))) + (All [a] (-> a (All [!] (-> (Box ! a) (Thread ! Top))))) (function (_ !) ("lux box write" value box))) diff --git a/stdlib/source/lux/control/writer.lux b/stdlib/source/lux/control/writer.lux index c65a9b29e..7f23e2750 100644 --- a/stdlib/source/lux/control/writer.lux +++ b/stdlib/source/lux/control/writer.lux @@ -44,7 +44,7 @@ (def: #export (log l) {#.doc "Set the log to a particular value."} - (All [l] (-> l (Writer l Unit))) + (All [l] (-> l (Writer l Top))) [l []]) (struct: #export (WriterT Monoid<l> Monad<M>) diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux index 7dfb7be5e..c4dd43a1c 100644 --- a/stdlib/source/lux/data/format/json.lux +++ b/stdlib/source/lux/data/format/json.lux @@ -27,7 +27,7 @@ (do-template [<name> <type>] [(type: #export <name> <type>)] - [Null Unit] + [Null Top] [Boolean Bool] [Number Frac] [String Text] @@ -237,7 +237,7 @@ _ (fail ($_ text/compose "JSON value is not " <desc> ".")))))] - [null Unit #Null "null"] + [null Top #Null "null"] [boolean Bool #Boolean "boolean"] [number Frac #Number "number"] [string Text #String "string"] @@ -258,7 +258,7 @@ (def: #export (<check> test) {#.doc (code.text ($_ text/compose "Ensures a JSON value is a " <desc> "."))} - (-> <type> (Reader Unit)) + (-> <type> (Reader Top)) (do p.Monad<Parser> [head any] (case head @@ -398,7 +398,7 @@ (l.some l.space)) (def: data-sep - (l.Lexer [Text Unit Text]) + (l.Lexer [Text Top Text]) ($_ p.seq space~ (l.this ",") space~)) (def: null~ @@ -470,7 +470,7 @@ (wrap chars)))) (def: (kv~ json~) - (-> (-> Unit (l.Lexer JSON)) (l.Lexer [String JSON])) + (-> (-> Top (l.Lexer JSON)) (l.Lexer [String JSON])) (do p.Monad<Parser> [key string~ _ space~ @@ -481,7 +481,7 @@ (do-template [<name> <type> <open> <close> <elem-parser> <prep>] [(def: (<name> json~) - (-> (-> Unit (l.Lexer JSON)) (l.Lexer <type>)) + (-> (-> Top (l.Lexer JSON)) (l.Lexer <type>)) (do p.Monad<Parser> [_ (l.this <open>) _ space~ @@ -495,7 +495,7 @@ ) (def: (json~' _) - (-> Unit (l.Lexer JSON)) + (-> Top (l.Lexer JSON)) ($_ p.alt null~ boolean~ number~ string~ (array~ json~') (object~ json~'))) (struct: #export _ (Codec Text JSON) diff --git a/stdlib/source/lux/data/format/xml.lux b/stdlib/source/lux/data/format/xml.lux index 23b12a42d..d3c6292cd 100644 --- a/stdlib/source/lux/data/format/xml.lux +++ b/stdlib/source/lux/data/format/xml.lux @@ -304,7 +304,7 @@ (#E.Error error))) (def: #export (node tag) - (-> Ident (Reader Unit)) + (-> Ident (Reader Top)) (function (_ docs) (case docs #.Nil @@ -338,7 +338,7 @@ (wrap [tail output])))))) (def: #export ignore - (Reader Unit) + (Reader Top) (function (_ docs) (case docs #.Nil diff --git a/stdlib/source/lux/data/text/lexer.lux b/stdlib/source/lux/data/text/lexer.lux index 338e2b5ac..980926b90 100644 --- a/stdlib/source/lux/data/text/lexer.lux +++ b/stdlib/source/lux/data/text/lexer.lux @@ -63,7 +63,7 @@ (def: #export (this reference) {#.doc "Lex a text if it matches the given sample."} - (-> Text (Lexer Unit)) + (-> Text (Lexer Top)) (function (_ [offset tape]) (case (text.index-of' reference offset tape) (#.Some where) @@ -87,7 +87,7 @@ (def: #export end {#.doc "Ensure the lexer's input is empty."} - (Lexer Unit) + (Lexer Top) (function (_ (^@ input [offset tape])) (if (n/= offset (text.size tape)) (#e.Success [input []]) diff --git a/stdlib/source/lux/data/text/regex.lux b/stdlib/source/lux/data/text/regex.lux index 102f9632f..4bdc6d3c0 100644 --- a/stdlib/source/lux/data/text/regex.lux +++ b/stdlib/source/lux/data/text/regex.lux @@ -309,7 +309,7 @@ )) (def: (unflatten^ lexer) - (-> (l.Lexer Text) (l.Lexer [Text Unit])) + (-> (l.Lexer Text) (l.Lexer [Text Top])) (p.seq lexer (:: p.Monad<Parser> wrap []))) (def: (|||^ left right) diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux index 719f6dd6e..8bc565545 100644 --- a/stdlib/source/lux/host.jvm.lux +++ b/stdlib/source/lux/host.jvm.lux @@ -15,7 +15,7 @@ [macro #+ with-gensyms Functor<Meta> Monad<Meta>] (macro [code] ["s" syntax #+ syntax: Syntax]) - (lang [type]) + (lang [type "type/" Eq<Type>]) )) (do-template [<name> <op> <from> <to>] @@ -246,7 +246,7 @@ ["float" (primitive "java.lang.Float")] ["double" (primitive "java.lang.Double")] ["char" (primitive "java.lang.Character")] - ["void" .Unit]) + ["void" .Top]) _ #.None)) @@ -264,7 +264,7 @@ ["long" .Int] ["float" .Frac] ["double" .Frac] - ["void" .Unit]) + ["void" .Top]) _ #.None)) @@ -530,7 +530,7 @@ (-> Text Text (Syntax Code)) (do p.Monad<Parser> [#let [dotted-name (format "::" field-name)] - [_ _ value] (: (Syntax [Unit Unit Code]) + [_ _ value] (: (Syntax [Top Top Code]) (s.form ($_ p.seq (s.this (' :=)) (s.this (code.symbol ["" dotted-name])) s.any)))] (wrap (`' ((~ (code.text (format "jvm putfield" ":" class-name ":" field-name))) _jvm_this (~ value)))))) @@ -657,7 +657,7 @@ (s.this (' >)))) (def: (assert-no-periods name) - (-> Text (Syntax Unit)) + (-> Text (Syntax Top)) (p.assert "Names in class declarations cannot contain periods." (not (text.contains? "." name)))) @@ -1809,8 +1809,8 @@ (` ((~ setter-name) (~ g!value))) (` ((~ setter-name) (~ g!value) (~ g!obj)))) setter-type (if import-field-static? - (` (All [(~+ tvar-asts)] (-> (~ typeC) (IO Unit)))) - (` (All [(~+ tvar-asts)] (-> (~ typeC) (~ classC) (IO Unit))))) + (` (All [(~+ tvar-asts)] (-> (~ typeC) (IO Top)))) + (` (All [(~+ tvar-asts)] (-> (~ typeC) (~ classC) (IO Top))))) setter-value (with-mode-field-set import-field-mode import-field-type g!value) setter-value (if import-field-maybe? (` (!!! (~ setter-value))) @@ -1942,27 +1942,25 @@ (def: (type->class-name type) (-> Type (Meta Text)) - (case type - (#.Primitive name params) - (:: Monad<Meta> wrap name) + (if (type/= Top type) + (:: Monad<Meta> wrap "java.lang.Object") + (case type + (#.Primitive name params) + (:: Monad<Meta> wrap name) - (#.Apply A F) - (case (type.apply (list A) F) - #.None - (macro.fail (format "Cannot apply type: " (type.to-text F) " to " (type.to-text A))) + (#.Apply A F) + (case (type.apply (list A) F) + #.None + (macro.fail (format "Cannot apply type: " (type.to-text F) " to " (type.to-text A))) - (#.Some type') - (type->class-name type')) - - (#.Named _ type') - (type->class-name type') + (#.Some type') + (type->class-name type')) + + (#.Named _ type') + (type->class-name type') - #.Unit - (:: Monad<Meta> wrap "java.lang.Object") - - (^or #.Void (#.Var _) (#.Ex _) (#.Bound _) (#.Sum _) (#.Product _) (#.Function _) (#.UnivQ _) (#.ExQ _)) - (macro.fail (format "Cannot convert to JvmType: " (type.to-text type))) - )) + _ + (macro.fail (format "Cannot convert to JvmType: " (type.to-text type)))))) (syntax: #export (array-read idx array) {#.doc (doc "Loads an element from an array." diff --git a/stdlib/source/lux/io.lux b/stdlib/source/lux/io.lux index 613959b4f..72307c301 100644 --- a/stdlib/source/lux/io.lux +++ b/stdlib/source/lux/io.lux @@ -9,7 +9,7 @@ (type: #export (IO a) {#.doc "A type that represents synchronous, effectful computations that may interact with the outside world."} - (-> Void a)) + (-> Bottom a)) (macro: #export (io tokens state) {#.doc (doc "Delays the evaluation of an expression, by wrapping it in an IO 'thunk'." @@ -27,13 +27,13 @@ (struct: #export _ (Functor IO) (def: (map f ma) - (io (f (ma (:! Void [])))))) + (io (f (ma (:! Bottom [])))))) (struct: #export _ (Apply IO) (def: functor Functor<IO>) (def: (apply ff fa) - (io ((ff (:! Void [])) (fa (:! Void [])))))) + (io ((ff (:! Bottom [])) (fa (:! Bottom [])))))) (struct: #export _ (Monad IO) (def: functor Functor<IO>) @@ -42,12 +42,12 @@ (io x)) (def: (join mma) - (io ((mma (:! Void [])) (:! Void []))))) + (io ((mma (:! Bottom [])) (:! Bottom []))))) (def: #export (run action) {#.doc "A way to execute IO computations and perform their side-effects."} (All [a] (-> (IO a) a)) - (action (:! Void []))) + (action (:! Bottom []))) ## Process (type: #export (Process a) diff --git a/stdlib/source/lux/lang/syntax.lux b/stdlib/source/lux/lang/syntax.lux index 0fefc1929..d30436533 100644 --- a/stdlib/source/lux/lang/syntax.lux +++ b/stdlib/source/lux/lang/syntax.lux @@ -82,7 +82,7 @@ ## This is just a helper parser to find text which doesn't run into ## any special character sequences for multi-line comments. (def: comment-bound^ - (l.Lexer Unit) + (l.Lexer Top) ($_ p.either (l.this new-line) (l.this ")#") diff --git a/stdlib/source/lux/lang/type.lux b/stdlib/source/lux/lang/type.lux index 35c2cd29c..48db0b928 100644 --- a/stdlib/source/lux/lang/type.lux +++ b/stdlib/source/lux/lang/type.lux @@ -54,11 +54,6 @@ (list.zip2 xparams yparams))) (^template [<tag>] - [<tag> <tag>] - true) - ([#.Void] [#.Unit]) - - (^template [<tag>] [(<tag> xid) (<tag> yid)] (n/= yid xid)) ([#.Var] [#.Ex] [#.Bound]) @@ -172,11 +167,6 @@ (.list (~+ (list/map to-code params))))) (^template [<tag>] - <tag> - (` <tag>)) - ([#.Void] [#.Unit]) - - (^template [<tag>] (<tag> idx) (` (<tag> (~ (code.nat idx))))) ([#.Var] [#.Ex] [#.Bound]) @@ -208,12 +198,6 @@ _ ($_ text/compose "(primitive " name " " (|> params (list/map to-text) list.reverse (list.interpose " ") (list/fold text/compose "")) ")")) - #.Void - "Void" - - #.Unit - "Unit" - (^template [<tag> <open> <close> <flatten>] (<tag> _) ($_ text/compose <open> @@ -290,8 +274,8 @@ (#.Cons type types') (<ctor> type (<name> types'))))] - [variant Void #.Sum] - [tuple Unit #.Product] + [variant Bottom #.Sum] + [tuple Top #.Product] ) (def: #export (function inputs output) diff --git a/stdlib/source/lux/lang/type/check.lux b/stdlib/source/lux/lang/type/check.lux index f71ac4150..1853f0931 100644 --- a/stdlib/source/lux/lang/type/check.lux +++ b/stdlib/source/lux/lang/type/check.lux @@ -199,7 +199,7 @@ (ex.throw unknown-type-var id)))) (def: #export (write type id) - (-> Type Var (Check Unit)) + (-> Type Var (Check Top)) (function (_ context) (case (|> context (get@ #.var-bindings) (var::get id)) (#.Some (#.Some bound)) @@ -213,7 +213,7 @@ (ex.throw unknown-type-var id)))) (def: (update type id) - (-> Type Var (Check Unit)) + (-> Type Var (Check Top)) (function (_ context) (case (|> context (get@ #.var-bindings) (var::get id)) (#.Some _) @@ -239,7 +239,7 @@ (get@ #.var-bindings context)]))) (def: (set-bindings value) - (-> (List [Var (Maybe Type)]) (Check Unit)) + (-> (List [Var (Maybe Type)]) (Check Top)) (function (_ context) (#e.Success [(set@ #.var-bindings value context) []]))) @@ -315,7 +315,7 @@ (#e.Error message))) (def: #export (assert message test) - (-> Text Bool (Check Unit)) + (-> Text Bool (Check Top)) (function (_ context) (if test (#e.Success [context []]) @@ -361,13 +361,13 @@ (else (maybe.default (#.Var id) ?bound))))) (def: (link-2 left right) - (-> Var Var (Check Unit)) + (-> Var Var (Check Top)) (do Monad<Check> [_ (write (#.Var right) left)] (write (#.Var left) right))) (def: (link-3 interpose to from) - (-> Var Var Var (Check Unit)) + (-> Var Var Var (Check Top)) (do Monad<Check> [_ (update (#.Var interpose) from)] (update (#.Var to) interpose))) @@ -445,7 +445,7 @@ (check' etype atype assumptions)))))) (def: (with-error-stack on-error check) - (All [a] (-> (-> Unit Text) (Check a) (Check a))) + (All [a] (-> (-> Top Text) (Check a) (Check a))) (function (_ context) (case (check context) (#e.Error error) @@ -592,16 +592,13 @@ (check/wrap assumptions)) (fail "")) - (^template [<identity> <compose>] - [<identity> <identity>] - (check/wrap assumptions) - + (^template [<compose>] [(<compose> eL eR) (<compose> aL aR)] (do Monad<Check> [assumptions (check' eL aL assumptions)] (check' eR aR assumptions))) - ([#.Void #.Sum] - [#.Unit #.Product]) + ([#.Sum] + [#.Product]) [(#.Function eI eO) (#.Function aI aO)] (do Monad<Check> @@ -624,7 +621,7 @@ (def: #export (check expected actual) {#.doc "Type-check to ensure that the 'expected' type subsumes the 'actual' type."} - (-> Type Type (Check Unit)) + (-> Type Type (Check Top)) (do Monad<Check> [assumptions (check' expected actual (list))] (wrap []))) @@ -652,7 +649,7 @@ [paramsT+' (monad.map @ clean paramsT+)] (wrap (#.Primitive name paramsT+'))) - (^or #.Void #.Unit (#.Bound _) (#.Ex _) (#.Named _)) + (^or (#.Bound _) (#.Ex _) (#.Named _)) (:: Monad<Check> wrap inputT) (^template [<tag>] diff --git a/stdlib/source/lux/macro.lux b/stdlib/source/lux/macro.lux index 238028f52..9b2b5fac8 100644 --- a/stdlib/source/lux/macro.lux +++ b/stdlib/source/lux/macro.lux @@ -97,7 +97,7 @@ (def: #export (assert message test) {#.doc "Fails with the given message if the test is false."} - (-> Text Bool (Meta Unit)) + (-> Text Bool (Meta Top)) (function (_ compiler) (if test (#e.Success [compiler []]) diff --git a/stdlib/source/lux/macro/poly.lux b/stdlib/source/lux/macro/poly.lux index b9336139b..f3537d6f0 100644 --- a/stdlib/source/lux/macro/poly.lux +++ b/stdlib/source/lux/macro/poly.lux @@ -20,7 +20,7 @@ (syntax ["cs" common] (common ["csr" reader] ["csw" writer]))) - (lang [type] + (lang [type "type/" Eq<Type>] (type [check])) )) @@ -117,7 +117,7 @@ (do-template [<combinator> <name> <type>] [(def: #export <combinator> - (Poly Unit) + (Poly Top) (do p.Monad<Parser> [headT any] (case (type.un-name headT) @@ -127,8 +127,6 @@ _ (p.fail ($_ text/compose "Not " <name> " type: " (type.to-text headT))))))] - [void "Void" #.Void] - [unit "Unit" #.Unit] [bool "Bool" (#.Primitive "#Bool" #.Nil)] [nat "Nat" (#.Primitive "#Nat" #.Nil)] [int "Int" (#.Primitive "#Int" #.Nil)] @@ -142,8 +140,6 @@ (do p.Monad<Parser> [headT any] (case (run headT ($_ p.either - void - unit bool nat int @@ -206,7 +202,7 @@ list.reverse))))] (recur (n/inc current-arg) (|> env' - (dict.put partialI [.Void partialC]) + (dict.put partialI [.Bottom partialC]) (dict.put partial-varI [(#.Bound partial-varI) partial-varL])) (#.Cons partial-varL all-varsL)))) [all-varsL env']))]] @@ -236,10 +232,10 @@ (local (#.Cons funcT paramsT) poly)))) (def: #export (this expected) - (-> Type (Poly Unit)) + (-> Type (Poly Top)) (do p.Monad<Parser> [actual any] - (if (check.checks? expected actual) + (if (type/= expected actual) (wrap []) (p.fail ($_ text/compose "Types do not match." "\n" @@ -271,7 +267,7 @@ (p.fail ($_ text/compose "Not a bound type: " (type.to-text headT)))))) (def: #export (var id) - (-> Nat (Poly Unit)) + (-> Nat (Poly Top)) (do p.Monad<Parser> [env ..env headT any] @@ -316,10 +312,10 @@ (do p.Monad<Parser> [headT any] (case (type.un-name headT) - (#.Apply #.Void (#.UnivQ _ headT')) + (#.Apply (#.Named ["lux" "Bottom"] _) (#.UnivQ _ headT')) (do @ [[recT _ output] (|> poly - (with-extension #.Void) + (with-extension .Bottom) (with-extension headT) (local (list headT')))] (wrap [recT output])) @@ -333,7 +329,7 @@ [env ..env headT any] (case (type.un-name headT) - (^multi (#.Apply #.Void (#.Bound funcT-idx)) + (^multi (#.Apply (#.Named ["lux" "Bottom"] _) (#.Bound funcT-idx)) (n/= +0 (adjusted-idx env funcT-idx)) [(dict.get +0 env) (#.Some [self-type self-call])]) (wrap self-call) @@ -430,11 +426,6 @@ (list (~+ (list/map (to-code env) params))))) (^template [<tag>] - <tag> - (` <tag>)) - ([#.Void] [#.Unit]) - - (^template [<tag>] (<tag> idx) (` (<tag> (~ (code.nat idx))))) ([#.Var] [#.Ex]) @@ -445,7 +436,7 @@ (|> (dict.get idx env) maybe.assume product.left (to-code env)) (` (.$ (~ (code.nat (n/dec idx))))))) - (#.Apply #.Void (#.Bound idx)) + (#.Apply (#.Named ["lux" "Bottom"] _) (#.Bound idx)) (let [idx (adjusted-idx env idx)] (if (n/= +0 idx) (|> (dict.get idx env) maybe.assume product.left (to-code env)) diff --git a/stdlib/source/lux/macro/poly/eq.lux b/stdlib/source/lux/macro/poly/eq.lux index 7990bd3c4..6206c9861 100644 --- a/stdlib/source/lux/macro/poly/eq.lux +++ b/stdlib/source/lux/macro/poly/eq.lux @@ -45,7 +45,7 @@ (wrap (` (: (~ (@Eq inputT)) <eq>))))] - [poly.unit (function ((~ g!_) (~ g!_) (~ g!_)) true)] + [(poly.this Top) (function ((~ g!_) (~ g!_) (~ g!_)) true)] [poly.bool bool.Eq<Bool>] [poly.nat number.Eq<Nat>] [poly.int number.Eq<Int>] diff --git a/stdlib/source/lux/macro/poly/json.lux b/stdlib/source/lux/macro/poly/json.lux index 38bf86866..971048296 100644 --- a/stdlib/source/lux/macro/poly/json.lux +++ b/stdlib/source/lux/macro/poly/json.lux @@ -79,19 +79,19 @@ (poly: Codec<JSON,?>//encode (with-expansions - [<basic> (do-template [<type> <matcher> <encoder>] + [<basic> (do-template [<matcher> <encoder>] [(do @ [#let [g!_ (code.local-symbol "_______")] _ <matcher>] (wrap (` (: (~ (@JSON//encode inputT)) <encoder>))))] - [Unit poly.unit (function ((~ g!_) (~ (code.symbol ["" "0"]))) #//.Null)] - [Bool poly.bool (|>> #//.Boolean)] - [Nat poly.nat (:: (~! ..Codec<JSON,Nat>) (~' encode))] - [Int poly.int (:: (~! ..Codec<JSON,Int>) (~' encode))] - [Frac poly.frac (|>> #//.Number)] - [Text poly.text (|>> #//.String)]) + [(poly.this Top) (function ((~ g!_) (~ (code.symbol ["" "0"]))) #//.Null)] + [poly.bool (|>> #//.Boolean)] + [poly.nat (:: (~! ..Codec<JSON,Nat>) (~' encode))] + [poly.int (:: (~! ..Codec<JSON,Int>) (~' encode))] + [poly.frac (|>> #//.Number)] + [poly.text (|>> #//.String)]) <time> (do-template [<type> <codec>] [(do @ [_ (poly.this <type>)] @@ -196,18 +196,18 @@ (poly: Codec<JSON,?>//decode (with-expansions - [<basic> (do-template [<type> <matcher> <decoder>] + [<basic> (do-template [<matcher> <decoder>] [(do @ [_ <matcher>] (wrap (` (: (~ (@JSON//decode inputT)) <decoder>))))] - [Unit poly.unit //.null] - [Bool poly.bool //.boolean] - [Nat poly.nat (p.codec (~! ..Codec<JSON,Nat>) //.any)] - [Int poly.int (p.codec (~! ..Codec<JSON,Int>) //.any)] - [Frac poly.frac //.number] - [Text poly.text //.string]) + [(poly.this Top) //.null] + [poly.bool //.boolean] + [poly.nat (p.codec (~! ..Codec<JSON,Nat>) //.any)] + [poly.int (p.codec (~! ..Codec<JSON,Int>) //.any)] + [poly.frac //.number] + [poly.text //.string]) <time> (do-template [<type> <codec>] [(do @ [_ (poly.this <type>)] @@ -297,8 +297,7 @@ (#Case2 Frac)) (type: Record - {#unit Unit - #bool Bool + {#bool Bool #frac Frac #text Text #maybe (Maybe Frac) diff --git a/stdlib/source/lux/macro/syntax.lux b/stdlib/source/lux/macro/syntax.lux index a3831f3fe..5c19d7560 100644 --- a/stdlib/source/lux/macro/syntax.lux +++ b/stdlib/source/lux/macro/syntax.lux @@ -80,7 +80,7 @@ (def: #export (this ast) {#.doc "Ensures the given Code is the next input."} - (-> Code (Syntax Unit)) + (-> Code (Syntax Top)) (function (_ tokens) (case tokens (#.Cons [token tokens']) @@ -143,7 +143,7 @@ (def: #export end! {#.doc "Ensures there are no more inputs."} - (Syntax Unit) + (Syntax Top) (function (_ tokens) (case tokens #.Nil (#e.Success [tokens []]) diff --git a/stdlib/source/lux/macro/syntax/common/reader.lux b/stdlib/source/lux/macro/syntax/common/reader.lux index f850bd217..360abd685 100644 --- a/stdlib/source/lux/macro/syntax/common/reader.lux +++ b/stdlib/source/lux/macro/syntax/common/reader.lux @@ -131,8 +131,7 @@ (wrap []) #.None - (p.fail "Typed definition must have a type!") - )] + (p.fail "Typed definition must have a type!"))] (wrap _definition))) (def: #export typed-input diff --git a/stdlib/source/lux/math/constructive.lux b/stdlib/source/lux/math/constructive.lux index f9192bdee..25fd6a29f 100644 --- a/stdlib/source/lux/math/constructive.lux +++ b/stdlib/source/lux/math/constructive.lux @@ -120,7 +120,7 @@ {} - .Unit)))) + .Top)))) (#.Some meaning) (wrap (.list (.` (.type: (~+ (scw.export export?)) diff --git a/stdlib/source/lux/math/random.lux b/stdlib/source/lux/math/random.lux index 930f2929d..2ae482c34 100644 --- a/stdlib/source/lux/math/random.lux +++ b/stdlib/source/lux/math/random.lux @@ -22,7 +22,7 @@ (type: #export #rec PRNG {#.doc "An abstract way to represent any PRNG."} - (-> Unit [PRNG Nat])) + (-> Top [PRNG Nat])) (type: #export (Random a) {#.doc "A producer of random values based on a PRNG."} diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux index 7a1877f68..e32bd2058 100644 --- a/stdlib/source/lux/test.lux +++ b/stdlib/source/lux/test.lux @@ -229,7 +229,7 @@ tests) num-tests (list.size tests+) groups (list.split-all promise.concurrency-level tests+)]] - (wrap (list (` (: (~! (IO Unit)) + (wrap (list (` (: (~! (IO Top)) ((~! io) (exec ((~! do) (~! promise.Monad<Promise>) [(~' #let) [(~ g!total-successes) +0 (~ g!total-failures) +0] diff --git a/stdlib/source/lux/type/abstract.lux b/stdlib/source/lux/type/abstract.lux index c23e3f456..be53d4d9d 100644 --- a/stdlib/source/lux/type/abstract.lux +++ b/stdlib/source/lux/type/abstract.lux @@ -58,7 +58,7 @@ (let [[module kind] (ident-for #..Representation)]))) (def: (install-casts' this-module-name name type-vars) - (-> Text Text (List Text) (Meta Unit)) + (-> Text Text (List Text) (Meta Top)) (do macro.Monad<Meta> [this-module (macro.find-module this-module-name) #let [type-varsC (list/map code.local-symbol type-vars) @@ -96,7 +96,7 @@ []])))) (def: (un-install-casts' this-module-name) - (-> Text (Meta Unit)) + (-> Text (Meta Top)) (do macro.Monad<Meta> [this-module (macro.find-module this-module-name) #let [this-module (|> this-module diff --git a/stdlib/source/lux/type/object/interface.lux b/stdlib/source/lux/type/object/interface.lux index e3a9f582c..f94177cd0 100644 --- a/stdlib/source/lux/type/object/interface.lux +++ b/stdlib/source/lux/type/object/interface.lux @@ -9,7 +9,7 @@ [ident #+ "ident/" Eq<Ident>] (coll [list "list/" Functor<List> Fold<List> Monoid<List>] (set ["set" unordered #+ Set]))) - [macro #+ Monad<Meta> "macro/" Monad<Meta>] + [macro #+ Monad<Meta> "meta/" Monad<Meta>] (macro [code] ["s" syntax #+ syntax:] (syntax ["cs" common] @@ -170,7 +170,7 @@ (#.Function inputT outputT) (let [[stateT+ objectT] (type.flatten-function currentT)] - (macro/wrap [depth stateT+])) + (meta/wrap [depth stateT+])) _ (macro.fail (format "Cannot extract inheritance from type: " (type.to-text newT)))))) @@ -317,12 +317,6 @@ (wrap (` (.primitive (~ (code.symbol ["" name])) (~+ paramsC+))))) - #.Void - (macro/wrap (` (.|))) - - #.Unit - (macro/wrap (` (.&))) - (^template [<tag> <macro> <flatten>] (<tag> _) (do Monad<Meta> @@ -340,7 +334,7 @@ (^template [<tag>] (<tag> idx) - (macro/wrap (` (<tag> (~ (code.nat idx)))))) + (meta/wrap (` (<tag> (~ (code.nat idx)))))) ([#.Bound] [#.Var] [#.Ex]) @@ -353,7 +347,7 @@ (wrap (` ((~ funcC) (~+ argsC+))))) (#.Named name unnamedT) - (macro/wrap (code.symbol name)) + (meta/wrap (code.symbol name)) _ (macro.fail (format "Cannot convert type to code: " (type.to-text type))))) diff --git a/stdlib/source/lux/type/resource.lux b/stdlib/source/lux/type/resource.lux index f25f322de..4558fa3a4 100644 --- a/stdlib/source/lux/type/resource.lux +++ b/stdlib/source/lux/type/resource.lux @@ -137,7 +137,7 @@ (wrap (list& head tail)))))))) (def: (no-op Monad<m>) - (All [m] (-> (Monad m) (Linear m Unit))) + (All [m] (-> (Monad m) (Linear m Top))) (function (_ context) (:: Monad<m> wrap [context []]))) (do-template [<name> <m> <monad>] @@ -166,7 +166,7 @@ (Procedure (~! <m>) [(~+ g!inputsT+) (~ g!context)] [(~+ g!outputsT+) (~ g!context)] - Unit)) + .Top)) (function ((~ g!_) [(~+ g!inputs) (~ g!context)]) (:: (~! <monad>) (~' wrap) [[(~+ g!outputs) (~ g!context)] []]))))))))))] @@ -191,7 +191,7 @@ (Procedure (~! <m>) [<from> (~ g!context)] [<to> (~ g!context)] - Unit)) + .Top)) (function ((~ g!_) [<from> (~ g!context)]) (:: (~! <monad>) (~' wrap) [[<to> (~ g!context)] []])))))))))] diff --git a/stdlib/source/lux/world/blob.jvm.lux b/stdlib/source/lux/world/blob.jvm.lux index d644b3d68..0027a4750 100644 --- a/stdlib/source/lux/world/blob.jvm.lux +++ b/stdlib/source/lux/world/blob.jvm.lux @@ -72,7 +72,7 @@ (ex.throw index-out-of-bounds (%n idx)))) (def: #export (write-8 idx value blob) - (-> Nat Nat Blob (e.Error Unit)) + (-> Nat Nat Blob (e.Error Top)) (if (n/< (host.array-length blob) idx) (exec (|> blob (host.array-write idx (host.long-to-byte (:! Int value)))) @@ -80,7 +80,7 @@ (ex.throw index-out-of-bounds (%n idx)))) (def: #export (write-16 idx value blob) - (-> Nat Nat Blob (e.Error Unit)) + (-> Nat Nat Blob (e.Error Top)) (if (n/< (host.array-length blob) (n/+ +1 idx)) (exec (|> blob (host.array-write idx (host.long-to-byte (:! Int (bit.shift-right +8 value)))) @@ -89,7 +89,7 @@ (ex.throw index-out-of-bounds (%n idx)))) (def: #export (write-32 idx value blob) - (-> Nat Nat Blob (e.Error Unit)) + (-> Nat Nat Blob (e.Error Top)) (if (n/< (host.array-length blob) (n/+ +3 idx)) (exec (|> blob (host.array-write idx (host.long-to-byte (:! Int (bit.shift-right +24 value)))) @@ -100,7 +100,7 @@ (ex.throw index-out-of-bounds (%n idx)))) (def: #export (write-64 idx value blob) - (-> Nat Nat Blob (e.Error Unit)) + (-> Nat Nat Blob (e.Error Top)) (if (n/< (host.array-length blob) (n/+ +7 idx)) (exec (|> blob (host.array-write idx (host.long-to-byte (:! Int (bit.shift-right +56 value)))) diff --git a/stdlib/source/lux/world/console.lux b/stdlib/source/lux/world/console.lux index 9d5fc6359..349c8853c 100644 --- a/stdlib/source/lux/world/console.lux +++ b/stdlib/source/lux/world/console.lux @@ -12,8 +12,8 @@ (interface: #export Console (read-char [] (Task Text)) (read-line [] (Task Text)) - (write [Text] (Task Unit)) - (close [] (Task Unit))) + (write [Text] (Task Top)) + (close [] (Task Top))) (for {"JVM" (as-is (host.import java/io/InputStream diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux index 3a729e936..93a7bdd73 100644 --- a/stdlib/source/lux/world/file.lux +++ b/stdlib/source/lux/world/file.lux @@ -53,7 +53,7 @@ (do-template [<name> <flag>] [(def: #export (<name> data file) - (-> Blob File (Process Unit)) + (-> Blob File (Process Top)) (do io.Monad<Process> [stream (FileOutputStream::new [(java/io/File::new file) <flag>]) _ (OutputStream::write [data] stream) diff --git a/stdlib/source/lux/world/net/tcp.jvm.lux b/stdlib/source/lux/world/net/tcp.jvm.lux index e32502e87..38721662f 100644 --- a/stdlib/source/lux/world/net/tcp.jvm.lux +++ b/stdlib/source/lux/world/net/tcp.jvm.lux @@ -50,7 +50,7 @@ (wrap (int-to-nat bytes-read))))) (def: #export (write data offset length self) - (-> Blob Nat Nat TCP (Task Unit)) + (-> Blob Nat Nat TCP (Task Top)) (let [out (get@ #out (@representation self))] (promise.future (do io.Monad<Process> @@ -59,7 +59,7 @@ (Flushable::flush [] out))))) (def: #export (close self) - (-> TCP (Task Unit)) + (-> TCP (Task Top)) (let [(^open) (@representation self)] (promise.future (do io.Monad<Process> @@ -85,19 +85,19 @@ (tcp-client socket)))) (def: #export (server port) - (-> //.Port (Task [(Promise Unit) + (-> //.Port (Task [(Promise Top) (frp.Channel TCP)])) (promise.future (do (e.ErrorT io.Monad<IO>) [server (ServerSocket::new [(nat-to-int port)]) - #let [signal (: (Promise Unit) + #let [signal (: (Promise Top) (promise #.None)) _ (promise.await (function (_ _) (AutoCloseable::close [] server)) signal) output (: (frp.Channel TCP) (frp.channel [])) - _ (: (Promise Unit) + _ (: (Promise Top) (promise.future (loop [_ []] (do io.Monad<IO> diff --git a/stdlib/source/lux/world/net/udp.jvm.lux b/stdlib/source/lux/world/net/udp.jvm.lux index efa8c814a..a28adc6bd 100644 --- a/stdlib/source/lux/world/net/udp.jvm.lux +++ b/stdlib/source/lux/world/net/udp.jvm.lux @@ -72,7 +72,7 @@ (int-to-nat (DatagramPacket::getPort [] packet))]))))) (def: #export (write address port data offset length self) - (-> //.Address //.Port Blob Nat Nat UDP (T.Task Unit)) + (-> //.Address //.Port Blob Nat Nat UDP (T.Task Top)) (P.future (do (e.ErrorT io.Monad<IO>) [address (resolve address) @@ -81,13 +81,13 @@ socket)))) (def: #export (close self) - (-> UDP (T.Task Unit)) + (-> UDP (T.Task Top)) (let [(^open) (@representation self)] (P.future (AutoCloseable::close [] socket)))) (def: #export (client _) - (-> Unit (T.Task UDP)) + (-> Top (T.Task UDP)) (P.future (do (e.ErrorT io.Monad<IO>) [socket (DatagramSocket::new|client [])] diff --git a/stdlib/test/test/lux/concurrency/frp.lux b/stdlib/test/test/lux/concurrency/frp.lux index e41f947fe..9630016e4 100644 --- a/stdlib/test/test/lux/concurrency/frp.lux +++ b/stdlib/test/test/lux/concurrency/frp.lux @@ -11,7 +11,7 @@ lux/test) (def: (write! values channel) - (All [a] (-> (List a) (Channel a) (IO Unit))) + (All [a] (-> (List a) (Channel a) (IO Top))) (do io.Monad<IO> [_ (monad.map @ (frp.publish channel) values)] (wrap []))) diff --git a/stdlib/test/test/lux/control/parser.lux b/stdlib/test/test/lux/control/parser.lux index ae69d8ec9..c295463cf 100644 --- a/stdlib/test/test/lux/control/parser.lux +++ b/stdlib/test/test/lux/control/parser.lux @@ -25,7 +25,7 @@ _ false)) (def: (enforced? parser input) - (All [s] (-> (&.Parser s Unit) s Bool)) + (All [s] (-> (&.Parser s Top) s Bool)) (case (&.run input parser) (#E.Success [_ []]) true diff --git a/stdlib/test/test/lux/control/region.lux b/stdlib/test/test/lux/control/region.lux index fc1eb7edf..429359057 100644 --- a/stdlib/test/test/lux/control/region.lux +++ b/stdlib/test/test/lux/control/region.lux @@ -73,7 +73,7 @@ count-clean-up (function (_ value) (do @ [_ (thread.update n/inc clean-up-counter)] - (wrap (: (Error Unit) (ex.throw oops [])))))] + (wrap (: (Error Top) (ex.throw oops [])))))] outcome (/.run @ (do (/.Monad<Region> @) [_ (monad.map @ (/.acquire @@ count-clean-up) diff --git a/stdlib/test/test/lux/data/format/json.lux b/stdlib/test/test/lux/data/format/json.lux index 9e1930f3f..e2781d2a5 100644 --- a/stdlib/test/test/lux/data/format/json.lux +++ b/stdlib/test/test/lux/data/format/json.lux @@ -76,8 +76,7 @@ (#Addition Frac Recursive)) (type: Record - {#unit Unit - #bool Bool + {#bool Bool #frac Frac #text Text #maybe (Maybe Frac) @@ -109,7 +108,6 @@ (do r.Monad<Random> [size (:: @ map (n/% +2) r.nat)] ($_ r.seq - (:: @ wrap []) r.bool r.frac (r.text size) diff --git a/stdlib/test/test/lux/lang/type.lux b/stdlib/test/test/lux/lang/type.lux index 113d279ee..0c7fa84be 100644 --- a/stdlib/test/test/lux/lang/type.lux +++ b/stdlib/test/test/lux/lang/type.lux @@ -29,8 +29,6 @@ (r.rec (function (_ gen-type) ($_ r.alt (r.seq gen-name (R/wrap (list))) - (R/wrap []) - (R/wrap []) (r.seq gen-type gen-type) (r.seq gen-type gen-type) (r.seq gen-type gen-type) @@ -104,8 +102,8 @@ (and (L/= (list) members) (L/= (list <unit>) flat)))))] - ["variant" &.variant &.flatten-variant Void] - ["tuple" &.tuple &.flatten-tuple Unit] + ["variant" &.variant &.flatten-variant Bottom] + ["tuple" &.tuple &.flatten-tuple Top] )] ($_ seq <struct-tests> diff --git a/stdlib/test/test/lux/lang/type/check.lux b/stdlib/test/test/lux/lang/type/check.lux index 48a3f35cb..e10ac5514 100644 --- a/stdlib/test/test/lux/lang/type/check.lux +++ b/stdlib/test/test/lux/lang/type/check.lux @@ -32,8 +32,6 @@ (r.rec (function (_ gen-type) ($_ r.alt (r.seq gen-name (r/wrap (list))) - (r/wrap []) - (r/wrap []) (r.seq gen-type gen-type) (r.seq gen-type gen-type) (r.seq gen-type gen-type) @@ -52,7 +50,7 @@ (#.Primitive name params) (list.every? valid-type? params) - (^or #.Void #.Unit (#.Ex id)) + (#.Ex id) true (^template [<tag>] @@ -90,9 +88,9 @@ (context: "Simple type-checking." ($_ seq - (test "Unit and Void match themselves." - (and (@.checks? Void Void) - (@.checks? Unit Unit))) + (test "Top and Bottom match themselves." + (and (@.checks? Bottom Bottom) + (@.checks? Top Top))) (test "Existential types only match with themselves." (and (type-checks? (do @.Monad<Check> @@ -166,28 +164,28 @@ (test "Can bind unbound type-vars by type-checking against them." (and (type-checks? (do @.Monad<Check> [[id var] @.var] - (@.check var #.Unit))) + (@.check var .Top))) (type-checks? (do @.Monad<Check> [[id var] @.var] - (@.check #.Unit var))))) + (@.check .Top var))))) (test "Cannot rebind already bound type-vars." (not (type-checks? (do @.Monad<Check> [[id var] @.var - _ (@.check var #.Unit)] - (@.check var #.Void))))) + _ (@.check var .Bool)] + (@.check var .Nat))))) (test "If the type bound to a var is a super-type to another, then the var is also a super-type." (type-checks? (do @.Monad<Check> [[id var] @.var _ (@.check var Top)] - (@.check var #.Unit)))) + (@.check var .Bool)))) (test "If the type bound to a var is a sub-type of another, then the var is also a sub-type." (type-checks? (do @.Monad<Check> [[id var] @.var _ (@.check var Bottom)] - (@.check #.Unit var)))) + (@.check .Bool var)))) )) (def: (build-ring num-connections) diff --git a/stdlib/test/test/lux/macro/poly/eq.lux b/stdlib/test/test/lux/macro/poly/eq.lux index 4605de5d2..d22475b11 100644 --- a/stdlib/test/test/lux/macro/poly/eq.lux +++ b/stdlib/test/test/lux/macro/poly/eq.lux @@ -26,8 +26,7 @@ (#Addition Frac Recursive)) (type: Record - {#unit Unit - #bool Bool + {#bool Bool #int Int #frac Frac #text Text @@ -49,7 +48,6 @@ [size (:: @ map (n/% +2) r.nat) #let [gen-int (|> r.int (:: @ map (|>> int/abs (i/% 1_000_000))))]] ($_ r.seq - (:: @ wrap []) r.bool gen-int r.frac diff --git a/stdlib/test/test/lux/type/implicit.lux b/stdlib/test/test/lux/type/implicit.lux index a4dee260e..2ae01ed1b 100644 --- a/stdlib/test/test/lux/type/implicit.lux +++ b/stdlib/test/test/lux/type/implicit.lux @@ -6,7 +6,6 @@ [eq]) (data [number] [bool "bool/" Eq<Bool>] - maybe (coll [list])) ["r" math/random] (type implicit)) diff --git a/stdlib/test/test/lux/type/object/interface.lux b/stdlib/test/test/lux/type/object/interface.lux index a296d9558..7def3113a 100644 --- a/stdlib/test/test/lux/type/object/interface.lux +++ b/stdlib/test/test/lux/type/object/interface.lux @@ -23,7 +23,7 @@ (class: NatRC Resettable-Counter #super NatC - Unit + Top (def: reset (set@Counter +0))) @@ -48,7 +48,7 @@ (class: (ListI a) (Iterable a) #super (ListC a) - Unit + Top (def: enumerate get@Collection)) diff --git a/stdlib/test/test/lux/type/object/protocol.lux b/stdlib/test/test/lux/type/object/protocol.lux index d6596950b..e5a8dda4b 100644 --- a/stdlib/test/test/lux/type/object/protocol.lux +++ b/stdlib/test/test/lux/type/object/protocol.lux @@ -3,10 +3,10 @@ (lux (data text/format) (type (object protocol)))) -(type: Counter (Object (Method Unit Nat))) +(type: Counter (Object (Method Top Nat))) (def: (count [tick return] state) - (Class Nat (Method Unit Nat)) + (Class Nat (Method Top Nat)) (let [state' (n/inc state)] [(return state') state'])) @@ -48,20 +48,20 @@ (read [] a)) (def: (readM [tick return] state) - (All [s] (Class s (Method Unit s))) + (All [s] (Class s (Method Top s))) [(return state) state]) (protocol: (Add n) - (+ n Unit) - (- n Unit)) + (+ n Top) + (- n Top)) (protocol: (Mul n) - (* n Unit) - (/ n Unit)) + (* n Top) + (/ n Top)) (do-template [<name> <op>] [(def: (<name> [diff return] state) - (Class Nat (Method Nat Unit)) + (Class Nat (Method Nat Top)) [(return []) (<op> diff state)])] [+M n/+] @@ -108,11 +108,11 @@ (numberO (+0 (read [])))) (def: _test3 - [Unit NatO] + [Top NatO] (numberO (+1 (+0 (+ +123))))) (def: _test4 - [Unit NatO] + [Top NatO] (numberO (+1 (+1 (* +123))))) ## TODO: Fix when new-luxc is the official compiler. @@ -121,9 +121,9 @@ ## (numberO (^read (read [])))) ## (def: _test3 -## [Unit NatO] +## [Top NatO] ## (numberO (^add (+ +123)))) ## (def: _test4 -## [Unit NatO] +## [Top NatO] ## (numberO (^mul (* +123)))) |