diff options
Diffstat (limited to 'luxc')
| -rw-r--r-- | luxc/src/lux/analyser/proc/common.clj | 39 | ||||
| -rw-r--r-- | luxc/src/lux/compiler/jvm/proc/common.clj | 48 | ||||
| -rw-r--r-- | luxc/src/lux/type.clj | 11 |
3 files changed, 96 insertions, 2 deletions
diff --git a/luxc/src/lux/analyser/proc/common.clj b/luxc/src/lux/analyser/proc/common.clj index 7031a9135..e3951da18 100644 --- a/luxc/src/lux/analyser/proc/common.clj +++ b/luxc/src/lux/analyser/proc/common.clj @@ -436,6 +436,41 @@ (return (&/|list (&&/|meta exo-type _cursor (&&/$proc (&/T ["atom" "compare-and-swap"]) (&/|list =atom =old =new) (&/|list))))))))) +(defn ^:private analyse-box-new [analyse exo-type ?values] + (&type/with-var + (fn [$var] + (|do [:let [(&/$Cons ?init (&/$Nil)) ?values] + =init (&&/analyse-1 analyse $var ?init) + _ (&type/check exo-type (&/$UnivQ (&/|list) (&type/Box (&/$Bound 1) $var))) + _cursor &/cursor] + (return (&/|list (&&/|meta exo-type _cursor + (&&/$proc (&/T ["box" "new"]) (&/|list =init) (&/|list))))))))) + +(defn ^:private analyse-box-read [analyse exo-type ?values] + (&type/with-var + (fn [threadT] + (&type/with-var + (fn [valueT] + (|do [:let [(&/$Cons boxC (&/$Nil)) ?values] + boxA (&&/analyse-1 analyse (&type/Box threadT valueT) boxC) + _ (&type/check exo-type valueT) + _cursor &/cursor] + (return (&/|list (&&/|meta exo-type _cursor + (&&/$proc (&/T ["box" "read"]) (&/|list boxA) (&/|list))))))))))) + +(defn ^:private analyse-box-write [analyse exo-type ?values] + (&type/with-var + (fn [threadT] + (&type/with-var + (fn [valueT] + (|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) + _cursor &/cursor] + (return (&/|list (&&/|meta exo-type _cursor + (&&/$proc (&/T ["box" "write"]) (&/|list valueA boxA) (&/|list))))))))))) + (defn ^:private analyse-process-concurrency-level [analyse exo-type ?values] (|do [:let [(&/$Nil) ?values] _ (&type/check exo-type &type/Nat) @@ -465,6 +500,10 @@ "lux is" (analyse-lux-is analyse exo-type ?values) "lux try" (analyse-lux-try analyse exo-type ?values) + "lux box new" (analyse-box-new analyse exo-type ?values) + "lux box read" (analyse-box-read analyse exo-type ?values) + "lux box write" (analyse-box-write analyse exo-type ?values) + "lux io log" (analyse-io-log analyse exo-type ?values) "lux io error" (analyse-io-error analyse exo-type ?values) "lux io exit" (analyse-io-exit analyse exo-type ?values) diff --git a/luxc/src/lux/compiler/jvm/proc/common.clj b/luxc/src/lux/compiler/jvm/proc/common.clj index bead93256..b23a59ce1 100644 --- a/luxc/src/lux/compiler/jvm/proc/common.clj +++ b/luxc/src/lux/compiler/jvm/proc/common.clj @@ -759,6 +759,47 @@ &&/wrap-boolean)]] (return nil))) +(defn ^:private compile-box-new [compile ?values special-args] + (|do [:let [(&/$Cons initS (&/$Nil)) ?values] + ^MethodVisitor *writer* &/get-writer + :let [_ (doto *writer* + (.visitLdcInsn (int 1)) + (.visitTypeInsn Opcodes/ANEWARRAY "java/lang/Object"))] + :let [_ (doto *writer* + (.visitInsn Opcodes/DUP) + (.visitLdcInsn (int 0)))] + _ (compile initS) + :let [_ (doto *writer* + (.visitInsn Opcodes/AASTORE))]] + (return nil))) + +(defn ^:private compile-box-read [compile ?values special-args] + (|do [:let [(&/$Cons boxS (&/$Nil)) ?values + ;; (&/$Nil) special-args + ] + ^MethodVisitor *writer* &/get-writer + _ (compile boxS) + :let [_ (doto *writer* + (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;") + (.visitLdcInsn (int 0)) + (.visitInsn Opcodes/AALOAD))]] + (return nil))) + +(defn ^:private compile-box-write [compile ?values special-args] + (|do [:let [(&/$Cons valueS (&/$Cons boxS (&/$Nil))) ?values + ;; (&/$Nil) special-args + ] + ^MethodVisitor *writer* &/get-writer + _ (compile boxS) + :let [_ (doto *writer* + (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;") + (.visitLdcInsn (int 0)))] + _ (compile valueS) + :let [_ (doto *writer* + (.visitInsn Opcodes/AASTORE) + (.visitLdcInsn &/unit-tag))]] + (return nil))) + (defn ^:private compile-process-concurrency-level [compile ?values special-args] (|do [:let [(&/$Nil) ?values] ^MethodVisitor *writer* &/get-writer @@ -929,6 +970,13 @@ "pow" (compile-math-pow compile ?values special-args) ) + "box" + (case proc + "new" (compile-box-new compile ?values special-args) + "read" (compile-box-read compile ?values special-args) + "write" (compile-box-write compile ?values special-args) + ) + "atom" (case proc "new" (compile-atom-new compile ?values special-args) diff --git a/luxc/src/lux/type.clj b/luxc/src/lux/type.clj index d5d6b0316..84c00b978 100644 --- a/luxc/src/lux/type.clj +++ b/luxc/src/lux/type.clj @@ -32,13 +32,20 @@ (def Ident (&/$Named (&/T ["lux" "Ident"]) (&/$Product Text Text))) (do-template [<name> <tag>] - (defn <name> [elem-type] - (&/$Primitive <tag> (&/|list elem-type))) + (defn <name> [elemT] + (&/$Primitive <tag> (&/|list elemT))) Array "#Array" Atom "#Atom" ) +(do-template [<name> <tag>] + (defn <name> [threadT elemT] + (&/$Primitive <tag> (&/|list threadT elemT))) + + Box "#Box" + ) + (def Bottom (&/$Named (&/T ["lux" "Bottom"]) (&/$UnivQ empty-env |