From 80f1597b8a8cc5db3baf32b8ffb82ddf286bc3d3 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 17 Jan 2016 00:51:26 -0400 Subject: - Fixed a bug introduced when I made the change for the "unit" value to be a special String, rather than null. --- src/lux/analyser/host.clj | 4 +-- src/lux/analyser/lux.clj | 6 ++-- src/lux/analyser/module.clj | 22 ++++++------ src/lux/base.clj | 28 +++++++-------- src/lux/compiler.clj | 6 ++-- src/lux/compiler/base.clj | 4 +-- src/lux/compiler/cache.clj | 8 ++--- src/lux/compiler/host.clj | 86 ++++++++++++++++++++++----------------------- src/lux/compiler/lambda.clj | 2 +- src/lux/compiler/lux.clj | 30 ++++++++-------- src/lux/type.clj | 30 ++++++++-------- src/lux/type/host.clj | 8 ++--- 12 files changed, 117 insertions(+), 117 deletions(-) diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj index 24a67be87..8dff15622 100644 --- a/src/lux/analyser/host.clj +++ b/src/lux/analyser/host.clj @@ -38,7 +38,7 @@ nil exceptions)] (&/fail* (str "[Analyser Error] Unhandled exception: " missing-ex)) - (&/return* state nil))) + (&/return* state &/unit-tag))) ))) (defn ^:private with-catches [catches body] @@ -661,7 +661,7 @@ nil abstract-methods)]] (if (nil? missing-method) - (return nil) + (return &/unit-tag) (|let [[am-name am-inputs] missing-method] (fail (str "[Analyser Error] Missing method: " am-name " " "(" (->> am-inputs (&/|interpose " ") (&/fold str "")) ")")))))) diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index 7adc32b22..fba8ea15b 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -261,7 +261,7 @@ (|do [[[r-module r-name] [endo-type ?meta ?value]] (&&module/find-def module name) _ (if (and (clojure.lang.Util/identical &type/Type endo-type) (clojure.lang.Util/identical &type/Type exo-type)) - (return nil) + (return &/unit-tag) (&type/check exo-type endo-type)) _cursor &/cursor] (return (&/|list (&&/|meta endo-type _cursor @@ -518,7 +518,7 @@ (|do [module-name &/get-module-name _ (if (= module-name path) (fail (str "[Analyser Error] Module can't import itself: " path)) - (return nil))] + (return &/unit-tag))] (&/save-module (|do [already-compiled? (&&module/exists? path) active? (&/active-module? path) @@ -526,7 +526,7 @@ _ (&&module/add-import path) _ (if (not already-compiled?) (compile-module path) - (return nil))] + (return &/unit-tag))] (return &/Nil$))))) (defn analyse-alias [analyse compile-token ex-alias ex-module] diff --git a/src/lux/analyser/module.clj b/src/lux/analyser/module.clj index 16c020670..4b6013d8e 100644 --- a/src/lux/analyser/module.clj +++ b/src/lux/analyser/module.clj @@ -47,7 +47,7 @@ (fn [m] (&/update$ $imports (partial &/Cons$ module) m)) ms)) state) - nil)))) + &/unit-tag)))) (defn set-imports [imports] "(-> (List Text) (Lux (,)))" @@ -59,7 +59,7 @@ (fn [m] (&/set$ $imports imports m)) ms)) state) - nil)))) + &/unit-tag)))) (defn define [module name def-type def-meta def-value] (fn [state] @@ -76,7 +76,7 @@ #(&/|put name (&/T [def-type def-meta def-value]) %) m)) ms)))) - nil) + &/unit-tag) _ (fail* (str "[Analyser Error] Can't create a new global definition outside of a global environment: " module ";" name))))) @@ -132,7 +132,7 @@ (&/|put alias reference aliases)) %) ms)))) - nil)))) + &/unit-tag)))) (defn find-def [module name] (|do [current-module &/get-module-name] @@ -180,7 +180,7 @@ (defn create-module [name] "(-> Text (Lux (,)))" (fn [state] - (return* (&/update$ &/$modules #(&/|put name +init+ %) state) nil))) + (return* (&/update$ &/$modules #(&/|put name +init+ %) state) &/unit-tag))) (defn enter-module [name] "(-> Text (Lux (,)))" @@ -188,7 +188,7 @@ (return* (->> state (&/update$ &/$modules #(&/|put name +init+ %)) (&/set$ &/$envs (&/|list (&/env name)))) - nil))) + &/unit-tag))) (do-template [ ] (defn [module] @@ -208,15 +208,15 @@ _ (&/map% (fn [tag] (if (&/|get tag tags-table) (fail (str "[Analyser Error] Can't re-declare tag: " (&/ident->text (&/T [module tag])))) - (return nil))) + (return &/unit-tag))) tags)] - (return nil))) + (return &/unit-tag))) (defn ensure-undeclared-type [module name] (|do [types-table (types-by-module module) _ (&/assert! (nil? (&/|get name types-table)) (str "[Analyser Error] Can't re-declare type: " (&/ident->text (&/T [module name]))))] - (return nil))) + (return &/unit-tag))) (defn declare-tags [module tag-names type] "(-> Text (List Text) Type (Lux (,)))" @@ -241,7 +241,7 @@ (&/update$ $types (partial &/|put _name (&/T [tags type])))) =modules)) state) - nil)) + &/unit-tag)) (fail* (str "[Lux Error] Unknown module: " module)))))) (do-template [ ] @@ -283,7 +283,7 @@ (fail (str "[Analyser Error] Can't tag as lux;" "? if it's not a " ": " (str module ";" name))))) _ - (return nil))) + (return &/unit-tag))) test-type &type/Type &meta/type?-tag "type" test-macro &type/Macro &meta/macro?-tag "macro" diff --git a/src/lux/base.clj b/src/lux/base.clj index 044f22df6..aead20b41 100644 --- a/src/lux/base.clj +++ b/src/lux/base.clj @@ -519,7 +519,7 @@ (defn assert! [test message] (if test - (return nil) + (return unit-tag) (fail message))) (def get-state @@ -560,7 +560,7 @@ ($Left msg) (if (.equals "[Reader Error] EOF" msg) - (return* state nil) + (return* state unit-tag) (fail* msg))))) (defn ^:private normalize-char [char] @@ -648,7 +648,7 @@ (defn host [_] (let [store (atom {})] (T [;; "lux;writer" - (V $None nil) + (V $None unit-tag) ;; "lux;loader" (memory-class-loader store) ;; "lux;classes" @@ -662,7 +662,7 @@ (defn init-state [_] (T [;; "lux;source" - (V $None nil) + (V $None unit-tag) ;; "lux;cursor" (T ["" -1 -1]) ;; "lux;modules" @@ -672,7 +672,7 @@ ;; "lux;types" +init-bindings+ ;; "lux;expected" - (V $VoidT nil) + (V $VoidT unit-tag) ;; "lux;seed" 0 ;; "lux;eval?" @@ -953,17 +953,17 @@ (return* state (|keys (get$ $modules state))))) (defn when% [test body] - "(-> Bool (Lux (,)) (Lux (,)))" + "(-> Bool (Lux Unit) (Lux Unit))" (if test body - (return nil))) + (return unit-tag))) (defn |at [idx xs] "(All [a] (-> Int (List a) (Maybe a)))" (|case xs ($Cons x xs*) (cond (< idx 0) - (V $None nil) + (V $None unit-tag) (= idx 0) (V $Some x) @@ -972,7 +972,7 @@ (|at (dec idx) xs*)) ($Nil) - (V $None nil) + (V $None unit-tag) )) (defn normalize [ident] @@ -991,27 +991,27 @@ (defn |list-put [idx val xs] (|case xs ($Nil) - (V $None nil) + (V $None unit-tag) ($Cons x xs*) (if (= idx 0) (V $Some (V $Cons (T [val xs*]))) (|case (|list-put (dec idx) val xs*) - ($None) (V $None nil) + ($None) (V $None unit-tag) ($Some xs**) (V $Some (V $Cons (T [x xs**])))) ))) (do-template [ ] (do (defn [module] - "(-> Text (Lux (,)))" + "(-> Text (Lux Unit))" (fn [state] (let [state* (update$ $host (fn [host] (update$ $module-states (fn [module-states] - (|put module (V nil) module-states)) + (|put module (V unit-tag) module-states)) host)) state)] - (V $Right (T [state* nil]))))) + (V $Right (T [state* unit-tag]))))) (defn [module] "(-> Text (Lux Bool))" (fn [state] diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index 31e0ca3a2..d9b76b84b 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -460,7 +460,7 @@ (.visitInsn Opcodes/RETURN) (.visitMaxs 0 0) (.visitEnd))]] - (return nil))) + (return &/unit-tag))) :let [bytecode (.toByteArray (doto =class .visitEnd))] _ (&&/save-class! (str id) bytecode) @@ -494,8 +494,8 @@ _ (if (= "lux" name) (|do [_ &&host/compile-Function-class _ &&host/compile-LuxUtils-class] - (return nil)) - (return nil))] + (return &/unit-tag)) + (return &/unit-tag))] (fn [state] (|case ((&/with-writer =class (&/exhaust% compiler-step)) diff --git a/src/lux/compiler/base.clj b/src/lux/compiler/base.clj index b046b237f..66e3d23f2 100644 --- a/src/lux/compiler/base.clj +++ b/src/lux/compiler/base.clj @@ -64,7 +64,7 @@ (defn class-exists? [^String module ^String class-name] "(-> Text Text (IO Bool))" - (|do [_ (return nil) + (|do [_ (return &/unit-tag) :let [full-path (str output-dir "/" module "/" class-name ".class") exists? (.exists (File. full-path))]] (return exists?))) @@ -84,7 +84,7 @@ _ (when (not eval?) (write-output module name bytecode)) _ (load-class! loader real-name)]] - (return nil))) + (return &/unit-tag))) (do-template [ ] (do (defn [^MethodVisitor writer] diff --git a/src/lux/compiler/cache.clj b/src/lux/compiler/cache.clj index da49ef419..efba55f1a 100644 --- a/src/lux/compiler/cache.clj +++ b/src/lux/compiler/cache.clj @@ -50,13 +50,13 @@ (.exists (new File (str &&/output-dir "/" (&host/->module-class module) "/" module-class)))) (defn delete [module] - "(-> Text (Lux (,)))" + "(-> Text (Lux Unit))" (fn [state] (do (clean-file (new File (str &&/output-dir "/" (&host/->module-class module)))) - (return* state nil)))) + (return* state &/unit-tag)))) (defn clean [state] - "(-> Compiler (,))" + "(-> Compiler Unit)" (let [needed-modules (->> state (&/get$ &/$modules) &/|keys &/->seq set) outdated? #(-> ^File % .getName (string/replace &host/module-separator "/") (->> (contains? needed-modules)) not) outdate-files (->> &&/output-dir (new File) .listFiles seq (filter outdated?)) @@ -65,7 +65,7 @@ (.delete program-file)) (doseq [f outdate-files] (clean-file f)) - nil)) + &/unit-tag)) (let [->regex (fn [text] (re-pattern (java.util.regex.Pattern/quote text))) import-separator-re (->regex &&/import-separator) diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj index e7982a8ca..eb67b5215 100644 --- a/src/lux/compiler/host.clj +++ b/src/lux/compiler/host.clj @@ -109,7 +109,7 @@ _ (doto *writer* (.visitInsn ) ())]] - (return nil))) + (return &/unit-tag))) compile-jvm-iadd Opcodes/IADD "java.lang.Integer" "intValue" "()I" &&/wrap-int compile-jvm-isub Opcodes/ISUB "java.lang.Integer" "intValue" "()I" &&/wrap-int @@ -157,7 +157,7 @@ (.visitLabel $then) (.visitFieldInsn Opcodes/GETSTATIC (&host-generics/->bytecode-class-name "java.lang.Boolean") "FALSE" (&host-generics/->type-signature "java.lang.Boolean")) (.visitLabel $end))]] - (return nil))) + (return &/unit-tag))) compile-jvm-ieq Opcodes/IF_ICMPEQ "java.lang.Integer" "intValue" "()I" compile-jvm-ilt Opcodes/IF_ICMPLT "java.lang.Integer" "intValue" "()I" @@ -191,7 +191,7 @@ (.visitLabel $then) (.visitFieldInsn Opcodes/GETSTATIC (&host-generics/->bytecode-class-name "java.lang.Boolean") "TRUE" (&host-generics/->type-signature "java.lang.Boolean")) (.visitLabel $end))]] - (return nil))) + (return &/unit-tag))) compile-jvm-leq Opcodes/LCMP 0 "java.lang.Long" "longValue" "()J" compile-jvm-llt Opcodes/LCMP 1 "java.lang.Long" "longValue" "()J" @@ -218,7 +218,7 @@ :let [_ (doto *writer* (.visitMethodInsn Opcodes/INVOKESTATIC (&host-generics/->bytecode-class-name (&host-type/as-obj ?class)) ?method method-sig) (prepare-return! ?output-type))]] - (return nil))) + (return &/unit-tag))) (do-template [ ] (defn [compile ?class ?method ?classes ?object ?args ?output-type] @@ -237,7 +237,7 @@ :let [_ (doto *writer* (.visitMethodInsn ?class* ?method method-sig) (prepare-return! ?output-type))]] - (return nil))) + (return &/unit-tag))) compile-jvm-invokevirtual Opcodes/INVOKEVIRTUAL compile-jvm-invokeinterface Opcodes/INVOKEINTERFACE @@ -247,7 +247,7 @@ (defn compile-jvm-null [compile] (|do [^MethodVisitor *writer* &/get-writer :let [_ (.visitInsn *writer* Opcodes/ACONST_NULL)]] - (return nil))) + (return &/unit-tag))) (defn compile-jvm-null? [compile ?object] (|do [^MethodVisitor *writer* &/get-writer @@ -261,7 +261,7 @@ (.visitLabel $then) (.visitFieldInsn Opcodes/GETSTATIC (&host-generics/->bytecode-class-name "java.lang.Boolean") "TRUE" (&host-generics/->type-signature "java.lang.Boolean")) (.visitLabel $end))]] - (return nil))) + (return &/unit-tag))) (defn compile-jvm-new [compile ?class ?classes ?args] (|do [^MethodVisitor *writer* &/get-writer @@ -278,7 +278,7 @@ (&/zip2 ?classes ?args)) :let [_ (doto *writer* (.visitMethodInsn Opcodes/INVOKESPECIAL class* "" init-sig))]] - (return nil))) + (return &/unit-tag))) (do-template [ ] (do (defn [compile ?length] @@ -288,7 +288,7 @@ &&/unwrap-long (.visitInsn Opcodes/L2I))] :let [_ (.visitIntInsn *writer* Opcodes/NEWARRAY )]] - (return nil))) + (return &/unit-tag))) (defn [compile ?array ?idx] (|do [^MethodVisitor *writer* &/get-writer @@ -301,7 +301,7 @@ :let [_ (doto *writer* (.visitInsn ) )]] - (return nil))) + (return &/unit-tag))) (defn [compile ?array ?idx ?elem] (|do [^MethodVisitor *writer* &/get-writer @@ -316,7 +316,7 @@ :let [_ (doto *writer* (.visitInsn ))]] - (return nil))) + (return &/unit-tag))) ) Opcodes/T_BOOLEAN "[Z" compile-jvm-znewarray compile-jvm-zaload Opcodes/BALOAD compile-jvm-zastore Opcodes/BASTORE &&/wrap-boolean &&/unwrap-boolean @@ -336,7 +336,7 @@ &&/unwrap-long (.visitInsn Opcodes/L2I))] :let [_ (.visitTypeInsn *writer* Opcodes/ANEWARRAY (&host-generics/gclass->bytecode-class-name* ?gclass type-env))]] - (return nil))) + (return &/unit-tag))) (defn compile-jvm-aaload [compile ?array ?idx] (|do [^MethodVisitor *writer* &/get-writer @@ -348,7 +348,7 @@ &&/unwrap-long (.visitInsn Opcodes/L2I))] :let [_ (.visitInsn *writer* Opcodes/AALOAD)]] - (return nil))) + (return &/unit-tag))) (defn compile-jvm-aastore [compile ?array ?idx ?elem] (|do [^MethodVisitor *writer* &/get-writer @@ -362,7 +362,7 @@ (.visitInsn Opcodes/L2I))] _ (compile ?elem) :let [_ (.visitInsn *writer* Opcodes/AASTORE)]] - (return nil))) + (return &/unit-tag))) (defn compile-jvm-arraylength [compile ?array] (|do [^MethodVisitor *writer* &/get-writer @@ -373,7 +373,7 @@ (.visitInsn Opcodes/ARRAYLENGTH) (.visitInsn Opcodes/I2L) &&/wrap-long)]] - (return nil))) + (return &/unit-tag))) (defn compile-jvm-getstatic [compile ?class ?field ?output-type] (|do [^MethodVisitor *writer* &/get-writer @@ -381,7 +381,7 @@ :let [_ (doto *writer* (.visitFieldInsn Opcodes/GETSTATIC (&host-generics/->bytecode-class-name (&host-type/as-obj ?class)) ?field =output-type) (prepare-return! ?output-type))]] - (return nil))) + (return &/unit-tag))) (defn compile-jvm-getfield [compile ?class ?field ?object ?output-type] (|do [:let [class* (&host-generics/->bytecode-class-name (&host-type/as-obj ?class))] @@ -392,7 +392,7 @@ (.visitTypeInsn Opcodes/CHECKCAST class*) (.visitFieldInsn Opcodes/GETFIELD class* ?field =output-type) (prepare-return! ?output-type))]] - (return nil))) + (return &/unit-tag))) (defn compile-jvm-putstatic [compile ?class ?field ?value input-gclass ?input-type] (|do [^MethodVisitor *writer* &/get-writer @@ -402,7 +402,7 @@ (prepare-arg! (&host-generics/gclass->class-name input-gclass)) (.visitFieldInsn Opcodes/PUTSTATIC (&host-generics/->bytecode-class-name (&host-type/as-obj ?class)) ?field =input-sig) (.visitInsn Opcodes/ACONST_NULL))]] - (return nil))) + (return &/unit-tag))) (defn compile-jvm-putfield [compile ?class ?field ?object ?value input-gclass ?input-type] (|do [:let [class* (&host-generics/->bytecode-class-name (&host-type/as-obj ?class))] @@ -415,7 +415,7 @@ (prepare-arg! (&host-generics/gclass->class-name input-gclass)) (.visitFieldInsn Opcodes/PUTFIELD class* ?field =input-sig) (.visitInsn Opcodes/ACONST_NULL))]] - (return nil))) + (return &/unit-tag))) (defn compile-jvm-instanceof [compile class object] (|do [:let [class* (&host-generics/->bytecode-class-name class)] @@ -424,7 +424,7 @@ :let [_ (doto *writer* (.visitTypeInsn Opcodes/INSTANCEOF class*) (&&/wrap-boolean))]] - (return nil))) + (return &/unit-tag))) (defn ^:private compile-annotation [writer ann] (doto ^AnnotationVisitor (.visitAnnotation writer (&host-generics/->bytecode-class-name (:name ann)) true) @@ -432,7 +432,7 @@ (->> (|let [[param-name param-value] param]) (doseq [param (&/->seq (:params ann))]))) (.visitEnd)) - nil) + &/unit-tag) (defn ^:private compile-field [^ClassWriter writer field] (|let [[=name =anns =type] field @@ -441,7 +441,7 @@ (&host-generics/gclass->signature =type) nil)] (do (&/|map (partial compile-annotation =field) =anns) (.visitEnd =field) - nil))) + &/unit-tag))) (defn ^:private compile-method-return [^MethodVisitor writer output] (|case output @@ -519,7 +519,7 @@ (compile-method-return ?output) (.visitMaxs 0 0) (.visitEnd))]] - (return nil)))) + (return &/unit-tag)))) (&/$VirtualMethodAnalysis ?name ?anns ?gvars ?exceptions ?inputs ?output ?body) (|let [=method-decl (&/T [?name ?anns ?gvars ?exceptions (&/|map &/|second ?inputs) ?output]) @@ -538,7 +538,7 @@ (compile-method-return ?output) (.visitMaxs 0 0) (.visitEnd))]] - (return nil)))) + (return &/unit-tag)))) (&/$OverridenMethodAnalysis ?class-decl ?name ?anns ?gvars ?exceptions ?inputs ?output ?body) (|let [=method-decl (&/T [?name ?anns ?gvars ?exceptions (&/|map &/|second ?inputs) ?output]) @@ -557,7 +557,7 @@ (compile-method-return ?output) (.visitMaxs 0 0) (.visitEnd))]] - (return nil)))) + (return &/unit-tag)))) )) (defn ^:private compile-method-decl [^ClassWriter class-writer =method-decl] @@ -571,7 +571,7 @@ (->> =exceptions (&/|map &host-generics/gclass->class-name) &/->seq (into-array java.lang.String))) _ (&/|map (partial compile-annotation =method) =anns) _ (.visitEnd =method)] - nil)) + &/unit-tag)) (defn ^:private prepare-ctor-arg [^MethodVisitor writer type] (case type @@ -621,7 +621,7 @@ (|let [[type term] type+term] (|do [_ (compile term) :let [_ (prepare-ctor-arg =method type)]] - (return nil)))) + (return &/unit-tag)))) ctor-args) :let [_ (doto =method (.visitMethodInsn Opcodes/INVOKESPECIAL (&host-generics/->bytecode-class-name super-class-name) init-method (str "(" init-types ")" -return)) @@ -635,7 +635,7 @@ (.visitInsn Opcodes/RETURN) (.visitMaxs 0 0) (.visitEnd))]] - (return nil))))) + (return &/unit-tag))))) ) (defn compile-jvm-class [compile class-decl ?super-class ?interfaces ?anns ?fields ?methods env ??ctor-args] @@ -658,7 +658,7 @@ (add-anon-class- =class compile full-name ?super-class env ctor-args) _ - (return nil))] + (return &/unit-tag))] (&&/save-class! ?name (.toByteArray (doto =class .visitEnd))))) (defn compile-jvm-interface [compile interface-decl ?supers ?anns ?methods] @@ -692,7 +692,7 @@ (compile-jvm-interface nil interface-decl ?supers ?anns ?methods))) (def compile-LuxUtils-class - (|do [_ (return nil) + (|do [_ (return &/unit-tag) :let [full-name &&/lux-utils-class super-class (&host-generics/->bytecode-class-name "java.lang.Object") tag-sig (&host-generics/->type-signature "java.lang.String") @@ -829,15 +829,15 @@ $end (new Label) $catch-finally (new Label) compile-finally (|case ?finally - (&/$Some ?finally*) (|do [_ (return nil) + (&/$Some ?finally*) (|do [_ (return &/unit-tag) _ (compile ?finally*) :let [_ (doto *writer* (.visitInsn Opcodes/POP) (.visitJumpInsn Opcodes/GOTO $end))]] - (return nil)) - (&/$None) (|do [_ (return nil) + (return &/unit-tag)) + (&/$None) (|do [_ (return &/unit-tag) :let [_ (.visitJumpInsn *writer* Opcodes/GOTO $end)]] - (return nil))) + (return &/unit-tag))) catch-boundaries (&/|map (fn [_catch_] (|let [[?ex-class ?ex-idx ?catch-body] _catch_] (&/T [?ex-class (new Label) (new Label)]))) @@ -868,19 +868,19 @@ (&/$Some ?finally*) (|do [_ (compile ?finally*) :let [_ (.visitInsn *writer* Opcodes/POP)] :let [_ (.visitInsn *writer* Opcodes/ATHROW)]] - (return nil)) - (&/$None) (|do [_ (return nil) + (return &/unit-tag)) + (&/$None) (|do [_ (return &/unit-tag) :let [_ (.visitInsn *writer* Opcodes/ATHROW)]] - (return nil))) + (return &/unit-tag))) :let [_ (.visitJumpInsn *writer* Opcodes/GOTO $end)] :let [_ (.visitLabel *writer* $end)]] - (return nil))) + (return &/unit-tag))) (defn compile-jvm-throw [compile ?ex] (|do [^MethodVisitor *writer* &/get-writer _ (compile ?ex) :let [_ (.visitInsn *writer* Opcodes/ATHROW)]] - (return nil))) + (return &/unit-tag))) (do-template [ ] (defn [compile ?monitor] @@ -889,7 +889,7 @@ :let [_ (doto *writer* (.visitInsn ) (.visitInsn Opcodes/ACONST_NULL))]] - (return nil))) + (return &/unit-tag))) compile-jvm-monitorenter Opcodes/MONITORENTER compile-jvm-monitorexit Opcodes/MONITOREXIT @@ -907,7 +907,7 @@ (.visitMethodInsn Opcodes/INVOKEVIRTUAL (&host-generics/->bytecode-class-name ) ) (.visitInsn ) (.visitMethodInsn Opcodes/INVOKESPECIAL (&host-generics/->bytecode-class-name ) init-method ))]] - (return nil))) + (return &/unit-tag))) compile-jvm-d2f Opcodes/D2F "java.lang.Double" "doubleValue" "()D" "java.lang.Float" "(F)V" compile-jvm-d2i Opcodes/D2I "java.lang.Double" "doubleValue" "()D" "java.lang.Integer" "(I)V" @@ -946,7 +946,7 @@ :let [_ (doto *writer* (.visitInsn ) (.visitMethodInsn Opcodes/INVOKESPECIAL (&host-generics/->bytecode-class-name ) init-method ))]] - (return nil))) + (return &/unit-tag))) compile-jvm-iand Opcodes/IAND "intValue" "()I" "java.lang.Integer" "intValue" "()I" "java.lang.Integer" "java.lang.Integer" "(I)V" compile-jvm-ior Opcodes/IOR "intValue" "()I" "java.lang.Integer" "intValue" "()I" "java.lang.Integer" "java.lang.Integer" "(I)V" @@ -1049,4 +1049,4 @@ (.visitInsn Opcodes/RETURN) (.visitMaxs 0 0) (.visitEnd))]] - (return nil))))) + (return &/unit-tag))))) diff --git a/src/lux/compiler/lambda.clj b/src/lux/compiler/lambda.clj index 83714517f..9767e93dc 100644 --- a/src/lux/compiler/lambda.clj +++ b/src/lux/compiler/lambda.clj @@ -87,7 +87,7 @@ (compile ?source))) closed-over) :let [_ (.visitMethodInsn *writer* Opcodes/INVOKESPECIAL lambda-class "" init-signature)]] - (return nil))) + (return &/unit-tag))) ;; [Exports] (let [lambda-flags (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_SUPER) diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj index 3c09f6362..14d34e6dc 100644 --- a/src/lux/compiler/lux.clj +++ b/src/lux/compiler/lux.clj @@ -31,7 +31,7 @@ (defn compile-bool [compile ?value] (|do [^MethodVisitor *writer* &/get-writer :let [_ (.visitFieldInsn *writer* Opcodes/GETSTATIC "java/lang/Boolean" (if ?value "TRUE" "FALSE") "Ljava/lang/Boolean;")]] - (return nil))) + (return &/unit-tag))) (do-template [ ] (defn [compile value] @@ -41,7 +41,7 @@ (.visitInsn Opcodes/DUP) (.visitLdcInsn ( value)) (.visitMethodInsn Opcodes/INVOKESPECIAL "" ))]] - (return nil))) + (return &/unit-tag))) compile-int "java/lang/Long" "(J)V" long compile-real "java/lang/Double" "(D)V" double @@ -51,7 +51,7 @@ (defn compile-text [compile ?value] (|do [^MethodVisitor *writer* &/get-writer :let [_ (.visitLdcInsn *writer* ?value)]] - (return nil))) + (return &/unit-tag))) (defn compile-tuple [compile ?elems] (|do [^MethodVisitor *writer* &/get-writer @@ -59,7 +59,7 @@ (|case num-elems 0 (|do [:let [_ (.visitLdcInsn *writer* &/unit-tag)]] - (return nil)) + (return &/unit-tag)) 1 (compile (&/|head ?elems)) @@ -81,7 +81,7 @@ (.visitLdcInsn (int num-elems)) (.visitLdcInsn &/product-tag) (.visitInsn Opcodes/AASTORE))]] - (return nil))))) + (return &/unit-tag))))) (defn compile-variant [compile ?tag tail? ?value] (|do [^MethodVisitor *writer* &/get-writer @@ -105,12 +105,12 @@ (.visitLdcInsn (int 3)))] _ (compile ?value) :let [_ (.visitInsn *writer* Opcodes/AASTORE)]] - (return nil))) + (return &/unit-tag))) (defn compile-local [compile ?idx] (|do [^MethodVisitor *writer* &/get-writer :let [_ (.visitVarInsn *writer* Opcodes/ALOAD (int ?idx))]] - (return nil))) + (return &/unit-tag))) (defn compile-captured [compile ?scope ?captured-id ?source] (|do [^MethodVisitor *writer* &/get-writer @@ -120,12 +120,12 @@ (str (&host/->module-class (&/|head ?scope)) "/" (&host/location (&/|tail ?scope))) (str &&/closure-prefix ?captured-id) "Ljava/lang/Object;"))]] - (return nil))) + (return &/unit-tag))) (defn compile-global [compile ?owner-class ?name] (|do [^MethodVisitor *writer* &/get-writer :let [_ (.visitFieldInsn *writer* Opcodes/GETSTATIC (str (&host/->module-class ?owner-class) "/" (&host/def-name ?name)) &/value-field "Ljava/lang/Object;")]] - (return nil))) + (return &/unit-tag))) (defn compile-apply [compile ?fn ?args] (|do [^MethodVisitor *writer* &/get-writer @@ -135,7 +135,7 @@ :let [_ (.visitMethodInsn *writer* Opcodes/INVOKEINTERFACE &&/function-class "apply" &&/apply-signature)]] (return =arg))) ?args)] - (return nil))) + (return &/unit-tag))) (defn ^:private compile-def-type [compile ?body] (|do [:let [?def-type (|case ?body @@ -167,7 +167,7 @@ def-meta ?meta def-value (-> def-class (.getField &/value-field) (.get nil))] _ (&a-module/define module-name ?name def-type def-meta def-value)] - (return nil)) + (return &/unit-tag)) (fail (str "[Compilation Error] Aliases cannot contain meta-data: " module-name ";" ?name))) (&/$Some _) @@ -205,7 +205,7 @@ (.visitInsn Opcodes/RETURN) (.visitMaxs 0 0) (.visitEnd))]] - (return nil))) + (return &/unit-tag))) :let [_ (.visitEnd *writer*)] _ (&&/save-class! def-name (.toByteArray =class)) :let [def-class (&&/load-class! class-loader (&host-generics/->class-name current-class)) @@ -234,7 +234,7 @@ (fail "[Compiler Error] Incorrect format for tags."))) tags*) _ (&a-module/declare-tags module-name tags def-value)] - (return nil)) + (return &/unit-tag)) [false (&/$Some _)] (fail "[Compiler Error] Can't define tags for non-type.") @@ -243,9 +243,9 @@ (fail "[Compiler Error] Incorrect format for tags.") [_ (&/$None)] - (return nil)) + (return &/unit-tag)) :let [_ (println 'DEF (str module-name ";" ?name))]] - (return nil)))))) + (return &/unit-tag)))))) (defn compile-ann [compile ?value-ex ?type-ex ?value-type] (compile ?value-ex)) diff --git a/src/lux/type.clj b/src/lux/type.clj index cae91e588..7fbd3f39c 100644 --- a/src/lux/type.clj +++ b/src/lux/type.clj @@ -211,7 +211,7 @@ (return* (&/update$ &/$type-vars (fn [ts] (&/update$ &/$mappings #(&/|put id (&/V &/$Some type) %) ts)) state) - nil)) + &/unit-tag)) (fail* (str "[Type Error] Unknown type-var: " id " | " (->> state (&/get$ &/$type-vars) (&/get$ &/$mappings) &/|length)))))) ;; [Exports] @@ -234,7 +234,7 @@ (defn ^:private delete-var [id] (|do [? (bound? id) _ (if ? - (return nil) + (return &/unit-tag) (|do [ex existential] (set-var id ex)))] (fn [state] @@ -261,7 +261,7 @@ (fn [state] (return* (&/update$ &/$type-vars #(&/set$ &/$mappings (&/|remove id mappings*) %) state) - nil))) + &/unit-tag))) state)))) (defn with-var [k] @@ -584,12 +584,12 @@ (defn ^:private check* [class-loader fixpoints invariant?? expected actual] (if (clojure.lang.Util/identical expected actual) - (return (&/T [fixpoints nil])) + (return (&/T [fixpoints &/unit-tag])) (&/with-attempt (|case [expected actual] [(&/$VarT ?eid) (&/$VarT ?aid)] (if (.equals ^Object ?eid ?aid) - (return (&/T [fixpoints nil])) + (return (&/T [fixpoints &/unit-tag])) (|do [ebound (fn [state] (|case ((deref ?eid) state) (&/$Right state* ebound) @@ -607,7 +607,7 @@ (|case [ebound abound] [(&/$None _) (&/$None _)] (|do [_ (set-var ?eid actual)] - (return (&/T [fixpoints nil]))) + (return (&/T [fixpoints &/unit-tag]))) [(&/$Some etype) (&/$None _)] (check* class-loader fixpoints invariant?? etype actual) @@ -622,7 +622,7 @@ (fn [state] (|case ((set-var ?id actual) state) (&/$Right state* _) - (return* state* (&/T [fixpoints nil])) + (return* state* (&/T [fixpoints &/unit-tag])) (&/$Left _) ((|do [bound (deref ?id)] @@ -633,7 +633,7 @@ (fn [state] (|case ((set-var ?id expected) state) (&/$Right state* _) - (return* state* (&/T [fixpoints nil])) + (return* state* (&/T [fixpoints &/unit-tag])) (&/$Left _) ((|do [bound (deref ?id)] @@ -658,7 +658,7 @@ e* (apply-type F2 A1) a* (apply-type F2 A2) [fixpoints** _] (check* class-loader fixpoints* invariant?? e* a*)] - (return (&/T [fixpoints** nil]))) + (return (&/T [fixpoints** &/unit-tag]))) state))) [(&/$AppT F1 A1) (&/$AppT (&/$VarT ?id) A2)] @@ -674,7 +674,7 @@ e* (apply-type F1 A1) a* (apply-type F1 A2) [fixpoints** _] (check* class-loader fixpoints* invariant?? e* a*)] - (return (&/T [fixpoints** nil]))) + (return (&/T [fixpoints** &/unit-tag]))) state))) [(&/$AppT F A) _] @@ -691,7 +691,7 @@ (|case (fp-get fp-pair fixpoints) (&/$Some ?) (if ? - (return (&/T [fixpoints nil])) + (return (&/T [fixpoints &/unit-tag])) (check-error "" expected actual)) (&/$None) @@ -741,10 +741,10 @@ a!data) [(&/$VoidT) (&/$VoidT)] - (return (&/T [fixpoints nil])) + (return (&/T [fixpoints &/unit-tag])) [(&/$UnitT) (&/$UnitT)] - (return (&/T [fixpoints nil])) + (return (&/T [fixpoints &/unit-tag])) [(&/$LambdaT eI eO) (&/$LambdaT aI aO)] (|do [[fixpoints* _] (check* class-loader fixpoints invariant?? aI eI)] @@ -760,7 +760,7 @@ [(&/$ExT e!id) (&/$ExT a!id)] (if (.equals ^Object e!id a!id) - (return (&/T [fixpoints nil])) + (return (&/T [fixpoints &/unit-tag])) (check-error "" expected actual)) [(&/$NamedT ?ename ?etype) _] @@ -777,7 +777,7 @@ (defn check [expected actual] (|do [class-loader &/loader _ (check* class-loader init-fixpoints false expected actual)] - (return nil))) + (return &/unit-tag))) (defn actual-type [type] "(-> Type (Lux Type))" diff --git a/src/lux/type/host.clj b/src/lux/type/host.clj index ae225db1f..27afc1563 100644 --- a/src/lux/type/host.clj +++ b/src/lux/type/host.clj @@ -215,16 +215,16 @@ (|let [[e!name e!params] expected [a!name a!params] actual] (try (cond (= "java.lang.Object" e!name) - (return (&/T [fixpoints nil])) + (return (&/T [fixpoints &/unit-tag])) (= null-data-tag a!name) (if (not (primitive-type? e!name)) - (return (&/T [fixpoints nil])) + (return (&/T [fixpoints &/unit-tag])) (check-error "" (&/V &/$DataT expected) (&/V &/$DataT actual))) (= null-data-tag e!name) (if (= null-data-tag a!name) - (return (&/T [fixpoints nil])) + (return (&/T [fixpoints &/unit-tag])) (check-error "" (&/V &/$DataT expected) (&/V &/$DataT actual))) (and (= array-data-tag e!name) @@ -237,7 +237,7 @@ (cond (.equals ^Object e!name a!name) (if (= (&/|length e!params) (&/|length a!params)) (|do [_ (&/map2% check e!params a!params)] - (return (&/T [fixpoints nil]))) + (return (&/T [fixpoints &/unit-tag]))) (fail (str "[Type Error] Amounts of generic parameters don't match: " e!name "(" (&/|length e!params) ")" " vs " a!name "(" (&/|length a!params) ")"))) (not invariant??) -- cgit v1.2.3