From 38742d7c110f5a28f9ea4aec117cc531ac6c9b5e Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 13 May 2018 00:47:43 -0400 Subject: - Added new #I64 type as foundation for types based on 64-bit integers. --- luxc/src/lux/analyser/proc/common.clj | 135 ++++++++++++++++-------------- luxc/src/lux/compiler/jvm/proc/common.clj | 117 ++++++++++++-------------- luxc/src/lux/type.clj | 13 ++- luxc/src/lux/type/host.clj | 5 +- 4 files changed, 139 insertions(+), 131 deletions(-) (limited to 'luxc/src') diff --git a/luxc/src/lux/analyser/proc/common.clj b/luxc/src/lux/analyser/proc/common.clj index 589ce42e2..19d833cc2 100644 --- a/luxc/src/lux/analyser/proc/common.clj +++ b/luxc/src/lux/analyser/proc/common.clj @@ -122,51 +122,71 @@ (&/|list))))))) (do-template [ ] - (defn [analyse exo-type ?values] - (|do [:let [(&/$Cons input (&/$Cons mask (&/$Nil))) ?values] - =mask (&&/analyse-1 analyse &type/Nat mask) - =input (&&/analyse-1 analyse &type/Nat input) - _ (&type/check exo-type &type/Nat) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor - (&&/$proc (&/T ["bit" ]) (&/|list =input =mask) (&/|list))))))) + (let [inputT (&/$Apply &type/Top &type/I64) + outputT &type/I64] + (defn [analyse exo-type ?values] + (|do [:let [(&/$Cons mask (&/$Cons input (&/$Nil))) ?values] + =mask (&&/analyse-1 analyse inputT mask) + =input (&&/analyse-1 analyse inputT input) + _ (&type/check exo-type outputT) + _cursor &/cursor] + (return (&/|list (&&/|meta exo-type _cursor + (&&/$proc (&/T ["i64" ]) (&/|list =input =mask) (&/|list)))))))) - ^:private analyse-bit-and "and" - ^:private analyse-bit-or "or" - ^:private analyse-bit-xor "xor" + ^:private analyse-i64-and "and" + ^:private analyse-i64-or "or" + ^:private analyse-i64-xor "xor" ) -(do-template [ ] - (defn [analyse exo-type ?values] - (|do [:let [(&/$Cons input (&/$Cons shift (&/$Nil))) ?values] - =shift (&&/analyse-1 analyse &type/Nat shift) - =input (&&/analyse-1 analyse input) - _ (&type/check exo-type ) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor - (&&/$proc (&/T ["bit" ]) (&/|list =input =shift) (&/|list))))))) +(do-template [ ] + (let [inputT (&/$Apply &type/Top &type/I64) + outputT &type/I64] + (defn [analyse exo-type ?values] + (|do [:let [(&/$Cons shift (&/$Cons input (&/$Nil))) ?values] + =shift (&&/analyse-1 analyse &type/Nat shift) + =input (&&/analyse-1 analyse inputT input) + _ (&type/check exo-type outputT) + _cursor &/cursor] + (return (&/|list (&&/|meta exo-type _cursor + (&&/$proc (&/T ["i64" ]) (&/|list =input =shift) (&/|list)))))))) - ^:private analyse-bit-left-shift "left-shift" &type/Nat - ^:private analyse-bit-arithmetic-right-shift "arithmetic-right-shift" &type/Int - ^:private analyse-bit-logical-right-shift "logical-right-shift" &type/Nat + ^:private analyse-i64-left-shift "left-shift" + ^:private analyse-i64-arithmetic-right-shift "arithmetic-right-shift" + ^:private analyse-i64-logical-right-shift "logical-right-shift" ) (do-template [ ] - (defn [analyse exo-type ?values] - (|do [:let [(&/$Cons x (&/$Cons y (&/$Nil))) ?values] - =x (&&/analyse-1 analyse x) - =y (&&/analyse-1 analyse y) - _ (&type/check exo-type ) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor - (&&/$proc (&/T ) (&/|list =x =y) (&/|list))))))) + (let [inputT + outputT ] + (defn [analyse exo-type ?values] + (|do [:let [(&/$Cons paramC (&/$Cons subjectC (&/$Nil))) ?values] + paramA (&&/analyse-1 analyse paramC) + subjectA (&&/analyse-1 analyse subjectC) + _ (&type/check exo-type ) + _cursor &/cursor] + (return (&/|list (&&/|meta exo-type _cursor + (&&/$proc (&/T ) (&/|list subjectA paramA) (&/|list)))))))) + + ^:private analyse-i64-eq ["i64" "="] (&/$Apply &type/Top &type/I64) &type/Bool + ^:private analyse-i64-add ["i64" "+"] (&/$Apply &type/Top &type/I64) &type/I64 + ^:private analyse-i64-sub ["i64" "-"] (&/$Apply &type/Top &type/I64) &type/I64 + ) + +(do-template [ ] + (let [inputT + outputT ] + (defn [analyse exo-type ?values] + (|do [:let [(&/$Cons x (&/$Cons y (&/$Nil))) ?values] + =x (&&/analyse-1 analyse x) + =y (&&/analyse-1 analyse y) + _ (&type/check exo-type ) + _cursor &/cursor] + (return (&/|list (&&/|meta exo-type _cursor + (&&/$proc (&/T ) (&/|list =x =y) (&/|list)))))))) - ^:private analyse-int-add ["int" "+"] &type/Int &type/Int - ^:private analyse-int-sub ["int" "-"] &type/Int &type/Int ^:private analyse-int-mul ["int" "*"] &type/Int &type/Int ^:private analyse-int-div ["int" "/"] &type/Int &type/Int ^:private analyse-int-rem ["int" "%"] &type/Int &type/Int - ^:private analyse-int-eq ["int" "="] &type/Int &type/Bool ^:private analyse-int-lt ["int" "<"] &type/Int &type/Bool ^:private analyse-frac-add ["frac" "+"] &type/Frac &type/Frac @@ -207,9 +227,6 @@ (return (&/|list (&&/|meta exo-type _cursor (&&/$proc (&/T ) (&/|list) (&/|list))))))) - ^:private analyse-int-min &type/Int ["int" "min"] - ^:private analyse-int-max &type/Int ["int" "max"] - ^:private analyse-frac-smallest &type/Frac ["frac" "smallest"] ^:private analyse-frac-min &type/Frac ["frac" "min"] ^:private analyse-frac-max &type/Frac ["frac" "max"] @@ -227,14 +244,13 @@ (return (&/|list (&&/|meta exo-type _cursor (&&/$proc (&/T ) (&/|list =x) (&/|list))))))) - ^:private analyse-int-char &type/Int &type/Text ["int" "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"] + ^:private analyse-int-char &type/Int &type/Text ["int" "char"] + ^:private analyse-int-frac &type/Int &type/Frac ["int" "frac"] + ^:private analyse-frac-int &type/Frac &type/Int ["frac" "int"] - ^: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"] + ^: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"] ) (defn ^:private analyse-io-current-time [analyse exo-type ?values] @@ -399,12 +415,12 @@ (return (&/|list (&&/|meta exo-type _cursor (&&/$proc (&/T ["box" "write"]) (&/|list valueA boxA) (&/|list))))))))))) -(defn ^:private analyse-process-parallelism-level [analyse exo-type ?values] +(defn ^:private analyse-process-parallelism [analyse exo-type ?values] (|do [:let [(&/$Nil) ?values] _ (&type/check exo-type &type/Nat) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor - (&&/$proc (&/T ["process" "parallelism-level"]) (&/|list) (&/|list))))))) + (&&/$proc (&/T ["process" "parallelism"]) (&/|list) (&/|list))))))) (defn ^:private analyse-process-schedule [analyse exo-type ?values] (|do [:let [(&/$Cons ?milliseconds (&/$Cons ?procedure (&/$Nil))) ?values] @@ -440,30 +456,27 @@ "lux text char" (analyse-text-char analyse exo-type ?values) "lux text contains?" (analyse-text-contains? analyse exo-type ?values) - "lux bit and" (analyse-bit-and analyse exo-type ?values) - "lux bit or" (analyse-bit-or analyse exo-type ?values) - "lux bit xor" (analyse-bit-xor analyse exo-type ?values) - "lux bit left-shift" (analyse-bit-left-shift analyse exo-type ?values) - "lux bit arithmetic-right-shift" (analyse-bit-arithmetic-right-shift analyse exo-type ?values) - "lux bit logical-right-shift" (analyse-bit-logical-right-shift analyse exo-type ?values) - "lux array new" (analyse-array-new analyse exo-type ?values) "lux array get" (analyse-array-get analyse exo-type ?values) "lux array put" (analyse-array-put analyse exo-type ?values) "lux array remove" (analyse-array-remove analyse exo-type ?values) "lux array size" (analyse-array-size analyse exo-type ?values) + "lux i64 and" (analyse-i64-and analyse exo-type ?values) + "lux i64 or" (analyse-i64-or analyse exo-type ?values) + "lux i64 xor" (analyse-i64-xor analyse exo-type ?values) + "lux i64 left-shift" (analyse-i64-left-shift analyse exo-type ?values) + "lux i64 arithmetic-right-shift" (analyse-i64-arithmetic-right-shift analyse exo-type ?values) + "lux i64 logical-right-shift" (analyse-i64-logical-right-shift analyse exo-type ?values) + "lux i64 +" (analyse-i64-add analyse exo-type ?values) + "lux i64 -" (analyse-i64-sub analyse exo-type ?values) + "lux i64 =" (analyse-i64-eq analyse exo-type ?values) - "lux int +" (analyse-int-add analyse exo-type ?values) - "lux int -" (analyse-int-sub analyse exo-type ?values) "lux int *" (analyse-int-mul analyse exo-type ?values) "lux int /" (analyse-int-div analyse exo-type ?values) "lux int %" (analyse-int-rem analyse exo-type ?values) - "lux int =" (analyse-int-eq analyse exo-type ?values) "lux int <" (analyse-int-lt analyse exo-type ?values) - "lux int min" (analyse-int-min analyse exo-type ?values) - "lux int max" (analyse-int-max analyse exo-type ?values) - "lux int to-frac" (analyse-int-to-frac analyse exo-type ?values) + "lux int frac" (analyse-int-frac analyse exo-type ?values) "lux int char" (analyse-int-char analyse exo-type ?values) "lux frac +" (analyse-frac-add analyse exo-type ?values) @@ -481,7 +494,7 @@ "lux frac not-a-number" (analyse-frac-not-a-number analyse exo-type ?values) "lux frac positive-infinity" (analyse-frac-positive-infinity analyse exo-type ?values) "lux frac negative-infinity" (analyse-frac-negative-infinity analyse exo-type ?values) - "lux frac to-int" (analyse-frac-to-int analyse exo-type ?values) + "lux frac int" (analyse-frac-int analyse exo-type ?values) "lux math cos" (analyse-math-cos analyse exo-type ?values) "lux math sin" (analyse-math-sin analyse exo-type ?values) @@ -499,7 +512,7 @@ "lux atom read" (analyse-atom-read analyse exo-type ?values) "lux atom compare-and-swap" (analyse-atom-compare-and-swap analyse exo-type ?values) - "lux process parallelism-level" (analyse-process-parallelism-level analyse exo-type ?values) + "lux process parallelism" (analyse-process-parallelism analyse exo-type ?values) "lux process schedule" (analyse-process-schedule analyse exo-type ?values) ;; else diff --git a/luxc/src/lux/compiler/jvm/proc/common.clj b/luxc/src/lux/compiler/jvm/proc/common.clj index c671c5328..571bbadc7 100644 --- a/luxc/src/lux/compiler/jvm/proc/common.clj +++ b/luxc/src/lux/compiler/jvm/proc/common.clj @@ -125,9 +125,9 @@ &&/wrap-long)]] (return nil))) - ^:private compile-bit-and Opcodes/LAND - ^:private compile-bit-or Opcodes/LOR - ^:private compile-bit-xor Opcodes/LXOR + ^:private compile-i64-and Opcodes/LAND + ^:private compile-i64-or Opcodes/LOR + ^:private compile-i64-xor Opcodes/LXOR ) (do-template [ ] @@ -145,9 +145,9 @@ &&/wrap-long)]] (return nil))) - ^:private compile-bit-left-shift Opcodes/LSHL - ^:private compile-bit-arithmetic-right-shift Opcodes/LSHR - ^:private compile-bit-logical-right-shift Opcodes/LUSHR + ^:private compile-i64-left-shift Opcodes/LSHL + ^:private compile-i64-arithmetic-right-shift Opcodes/LSHR + ^:private compile-i64-logical-right-shift Opcodes/LUSHR ) (defn ^:private compile-lux-is [compile ?values special-args] @@ -191,8 +191,9 @@ )]] (return nil))) - ^:private compile-int-add Opcodes/LADD &&/unwrap-long &&/wrap-long - ^:private compile-int-sub Opcodes/LSUB &&/unwrap-long &&/wrap-long + ^:private compile-i64-add Opcodes/LADD &&/unwrap-long &&/wrap-long + ^:private compile-i64-sub Opcodes/LSUB &&/unwrap-long &&/wrap-long + ^:private compile-int-mul Opcodes/LMUL &&/unwrap-long &&/wrap-long ^:private compile-int-div Opcodes/LDIV &&/unwrap-long &&/wrap-long ^:private compile-int-rem Opcodes/LREM &&/unwrap-long &&/wrap-long @@ -227,61 +228,49 @@ (.visitLabel $end))]] (return nil))) - ^:private compile-int-eq Opcodes/LCMP 0 &&/unwrap-long + ^:private compile-i64-eq Opcodes/LCMP 0 &&/unwrap-long + ^:private compile-int-lt Opcodes/LCMP -1 &&/unwrap-long ^:private compile-frac-eq Opcodes/DCMPG 0 &&/unwrap-double ^:private compile-frac-lt Opcodes/DCMPG -1 &&/unwrap-double ) -(do-template [ ] +(do-template [ ] (defn [compile ?values special-args] (|do [:let [(&/$Nil) ?values] ^MethodVisitor *writer* &/get-writer :let [_ (doto *writer* - - )]] + (.visitLdcInsn ) + &&/wrap-double)]] (return nil))) - ^:private compile-int-min (.visitLdcInsn Long/MIN_VALUE) &&/wrap-long - ^:private compile-int-max (.visitLdcInsn Long/MAX_VALUE) &&/wrap-long - - ^:private compile-frac-smallest (.visitLdcInsn Double/MIN_VALUE) &&/wrap-double - ^:private compile-frac-min (.visitLdcInsn (* -1.0 Double/MAX_VALUE)) &&/wrap-double - ^:private compile-frac-max (.visitLdcInsn Double/MAX_VALUE) &&/wrap-double - - ^:private compile-frac-not-a-number (.visitLdcInsn Double/NaN) &&/wrap-double - ^:private compile-frac-positive-infinity (.visitLdcInsn Double/POSITIVE_INFINITY) &&/wrap-double - ^:private compile-frac-negative-infinity (.visitLdcInsn Double/NEGATIVE_INFINITY) &&/wrap-double - ) - -(do-template [ ] - (defn [compile ?values special-args] - (|do [:let [(&/$Cons ?input (&/$Nil)) ?values] - ^MethodVisitor *writer* &/get-writer - _ (compile ?input) - :let [_ (doto *writer* - - (.visitMethodInsn Opcodes/INVOKESTATIC "toString" ))]] - (return nil))) + ^:private compile-frac-smallest Double/MIN_VALUE + ^:private compile-frac-min (* -1.0 Double/MAX_VALUE) + ^:private compile-frac-max Double/MAX_VALUE - ^:private compile-frac-encode "java/lang/Double" "(D)Ljava/lang/String;" &&/unwrap-double + ^:private compile-frac-not-a-number Double/NaN + ^:private compile-frac-positive-infinity Double/POSITIVE_INFINITY + ^:private compile-frac-negative-infinity Double/NEGATIVE_INFINITY ) +(defn ^:private compile-frac-encode [compile ?values special-args] + (|do [:let [(&/$Cons ?input (&/$Nil)) ?values] + ^MethodVisitor *writer* &/get-writer + _ (compile ?input) + :let [_ (doto *writer* + &&/unwrap-double + (.visitMethodInsn Opcodes/INVOKESTATIC "java/lang/Double" "toString" "(D)Ljava/lang/String;"))]] + (return nil))) -(do-template [ ] - (defn [compile ?values special-args] - (|do [:let [(&/$Cons ?input (&/$Nil)) ?values] - ^MethodVisitor *writer* &/get-writer - _ (compile ?input) - :let [_ (doto *writer* - (.visitTypeInsn Opcodes/CHECKCAST "java/lang/String") - (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "(Ljava/lang/String;)[Ljava/lang/Object;"))]] - (return nil))) - - ^:private compile-int-decode "decode_int" - ^:private compile-frac-decode "decode_frac" - ) +(defn ^:private compile-frac-decode [compile ?values special-args] + (|do [:let [(&/$Cons ?input (&/$Nil)) ?values] + ^MethodVisitor *writer* &/get-writer + _ (compile ?input) + :let [_ (doto *writer* + (.visitTypeInsn Opcodes/CHECKCAST "java/lang/String") + (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "decode_frac" "(Ljava/lang/String;)[Ljava/lang/Object;"))]] + (return nil))) (defn ^:private compile-int-char [compile ?values special-args] (|do [:let [(&/$Cons ?x (&/$Nil)) ?values] @@ -305,8 +294,8 @@ )]] (return nil))) - ^:private compile-frac-to-int &&/unwrap-double Opcodes/D2L &&/wrap-long - ^:private compile-int-to-frac &&/unwrap-long Opcodes/L2D &&/wrap-double + ^:private compile-frac-int &&/unwrap-double Opcodes/D2L &&/wrap-long + ^:private compile-int-frac &&/unwrap-long Opcodes/L2D &&/wrap-double ) (defn ^:private compile-text-eq [compile ?values special-args] @@ -626,7 +615,7 @@ (.visitLdcInsn &/unit-tag))]] (return nil))) -(defn ^:private compile-process-parallelism-level [compile ?values special-args] +(defn ^:private compile-process-parallelism [compile ?values special-args] (|do [:let [(&/$Nil) ?values] ^MethodVisitor *writer* &/get-writer :let [_ (doto *writer* @@ -677,14 +666,17 @@ "contains?" (compile-text-contains? compile ?values special-args) ) - "bit" + "i64" (case proc - "and" (compile-bit-and compile ?values special-args) - "or" (compile-bit-or compile ?values special-args) - "xor" (compile-bit-xor compile ?values special-args) - "left-shift" (compile-bit-left-shift compile ?values special-args) - "arithmetic-right-shift" (compile-bit-arithmetic-right-shift compile ?values special-args) - "logical-right-shift" (compile-bit-logical-right-shift compile ?values special-args)) + "and" (compile-i64-and compile ?values special-args) + "or" (compile-i64-or compile ?values special-args) + "xor" (compile-i64-xor compile ?values special-args) + "left-shift" (compile-i64-left-shift compile ?values special-args) + "arithmetic-right-shift" (compile-i64-arithmetic-right-shift compile ?values special-args) + "logical-right-shift" (compile-i64-logical-right-shift compile ?values special-args) + "=" (compile-i64-eq compile ?values special-args) + "+" (compile-i64-add compile ?values special-args) + "-" (compile-i64-sub compile ?values special-args)) "array" (case proc @@ -696,16 +688,11 @@ "int" (case proc - "+" (compile-int-add compile ?values special-args) - "-" (compile-int-sub compile ?values special-args) "*" (compile-int-mul compile ?values special-args) "/" (compile-int-div compile ?values special-args) "%" (compile-int-rem compile ?values special-args) - "=" (compile-int-eq compile ?values special-args) "<" (compile-int-lt compile ?values special-args) - "max" (compile-int-max compile ?values special-args) - "min" (compile-int-min compile ?values special-args) - "to-frac" (compile-int-to-frac compile ?values special-args) + "frac" (compile-int-frac compile ?values special-args) "char" (compile-int-char compile ?values special-args) ) @@ -724,7 +711,7 @@ "not-a-number" (compile-frac-not-a-number compile ?values special-args) "positive-infinity" (compile-frac-positive-infinity compile ?values special-args) "negative-infinity" (compile-frac-negative-infinity compile ?values special-args) - "to-int" (compile-frac-to-int compile ?values special-args) + "int" (compile-frac-int compile ?values special-args) "encode" (compile-frac-encode compile ?values special-args) "decode" (compile-frac-decode compile ?values special-args) ) @@ -760,7 +747,7 @@ "process" (case proc - "parallelism-level" (compile-process-parallelism-level compile ?values special-args) + "parallelism" (compile-process-parallelism compile ?values special-args) "schedule" (compile-process-schedule compile ?values special-args) ) diff --git a/luxc/src/lux/type.clj b/luxc/src/lux/type.clj index b9c5898a7..c2650c5b8 100644 --- a/luxc/src/lux/type.clj +++ b/luxc/src/lux/type.clj @@ -23,10 +23,17 @@ (def empty-env &/$Nil) +(def I64 (&/$Named (&/T ["lux" "I64"]) + (&/$UnivQ empty-env + (&/$Primitive "#I64" (&/|list (&/$Bound 1)))))) +(def Nat* (&/$Primitive &&host/nat-data-tag &/$Nil)) +(def Deg* (&/$Primitive &&host/deg-data-tag &/$Nil)) +(def Int* (&/$Primitive &&host/int-data-tag &/$Nil)) + (def Bool (&/$Named (&/T ["lux" "Bool"]) (&/$Primitive "#Bool" &/$Nil))) -(def Nat (&/$Named (&/T ["lux" "Nat"]) (&/$Primitive &&host/nat-data-tag &/$Nil))) -(def Deg (&/$Named (&/T ["lux" "Deg"]) (&/$Primitive &&host/deg-data-tag &/$Nil))) -(def Int (&/$Named (&/T ["lux" "Int"]) (&/$Primitive "#Int" &/$Nil))) +(def Nat (&/$Named (&/T ["lux" "Nat"]) (&/$Apply Nat* I64))) +(def Deg (&/$Named (&/T ["lux" "Deg"]) (&/$Apply Deg* I64))) +(def Int (&/$Named (&/T ["lux" "Int"]) (&/$Apply Int* I64))) (def Frac (&/$Named (&/T ["lux" "Frac"]) (&/$Primitive "#Frac" &/$Nil))) (def Text (&/$Named (&/T ["lux" "Text"]) (&/$Primitive "#Text" &/$Nil))) (def Ident (&/$Named (&/T ["lux" "Ident"]) (&/$Product Text Text))) diff --git a/luxc/src/lux/type/host.clj b/luxc/src/lux/type/host.clj index 2e2db3bf6..d56e85fd7 100644 --- a/luxc/src/lux/type/host.clj +++ b/luxc/src/lux/type/host.clj @@ -66,7 +66,9 @@ ;; [Exports] (def array-data-tag "#Array") (def null-data-tag "#Null") +(def i64-data-tag "#I64") (def nat-data-tag "#Nat") +(def int-data-tag "#Int") (def deg-data-tag "#Deg") ;; [Utils] @@ -309,9 +311,8 @@ (def ^:private lux-jvm-type-combos #{#{"java.lang.Boolean" "#Bool"} - #{"java.lang.Long" "#Int"} + #{"java.lang.Long" i64-data-tag} #{"java.lang.Double" "#Frac"} - #{"java.lang.Character" "#Char"} #{"java.lang.String" "#Text"}}) (defn ^:private lux-type? [^String class-name] -- cgit v1.2.3