aboutsummaryrefslogtreecommitdiff
path: root/luxc/src
diff options
context:
space:
mode:
authorEduardo Julian2017-04-30 20:46:17 -0400
committerEduardo Julian2017-04-30 20:46:17 -0400
commit386cef921ec98ea7929e79713d0e58657e73d5cb (patch)
tree0c4bd2f7a17333c2001a3e8abc48fba6e55149f0 /luxc/src
parent08928ee851be2eca8c15a91445d4d44857bfcc14 (diff)
- Updated the compiler's type-checking context to match it with lux/type/check.
Diffstat (limited to 'luxc/src')
-rw-r--r--luxc/src/lux/base.clj20
-rw-r--r--luxc/src/lux/type.clj57
2 files changed, 49 insertions, 28 deletions
diff --git a/luxc/src/lux/base.clj b/luxc/src/lux/base.clj
index 2fe9952ee..bdbffdf35 100644
--- a/luxc/src/lux/base.clj
+++ b/luxc/src/lux/base.clj
@@ -110,6 +110,12 @@
["counter"
"mappings"])
+;; Type-Context
+(deftuple
+ ["ex-counter"
+ "var-counter"
+ "var-bindings"])
+
;; Env
(deftuple
["name"
@@ -148,7 +154,7 @@
"cursor"
"modules"
"scopes"
- "type-vars"
+ "type-context"
"expected"
"seed"
"scope-type-vars"
@@ -711,6 +717,14 @@
;; "lux;mappings"
(|table)]))
+(def +init-type-context+
+ (T [;; ex-counter
+ 0
+ ;; var-counter
+ 0
+ ;; var-bindings
+ (|table)]))
+
(defn env [name old-name]
(T [;; "lux;name"
($Cons name old-name)
@@ -821,8 +835,8 @@
(|table)
;; "lux;scopes"
$Nil
- ;; "lux;types"
- +init-bindings+
+ ;; "lux;type-context"
+ +init-type-context+
;; "lux;expected"
$None
;; "lux;seed"
diff --git a/luxc/src/lux/type.clj b/luxc/src/lux/type.clj
index 561d81795..f69542442 100644
--- a/luxc/src/lux/type.clj
+++ b/luxc/src/lux/type.clj
@@ -171,7 +171,7 @@
(defn bound? [id]
(fn [state]
- (if-let [type (->> state (&/get$ &/$type-vars) (&/get$ &/$mappings) (&/|get id))]
+ (if-let [type (->> state (&/get$ &/$type-context) (&/get$ &/$var-bindings) (&/|get id))]
(|case type
(&/$Some type*)
(return* state true)
@@ -183,7 +183,7 @@
(defn deref [id]
(fn [state]
- (if-let [type* (->> state (&/get$ &/$type-vars) (&/get$ &/$mappings) (&/|get id))]
+ (if-let [type* (->> state (&/get$ &/$type-context) (&/get$ &/$var-bindings) (&/|get id))]
(|case type*
(&/$Some type)
(return* state type)
@@ -205,7 +205,7 @@
(defn set-var [id type]
(fn [state]
- (if-let [tvar (->> state (&/get$ &/$type-vars) (&/get$ &/$mappings) (&/|get id))]
+ (if-let [tvar (->> state (&/get$ &/$type-context) (&/get$ &/$var-bindings) (&/|get id))]
(|case tvar
(&/$Some bound)
(if (type= type bound)
@@ -214,56 +214,63 @@
state))
(&/$None)
- (return* (&/update$ &/$type-vars (fn [ts] (&/update$ &/$mappings #(&/|put id (&/$Some type) %)
- ts))
+ (return* (&/update$ &/$type-context (fn [ts] (&/update$ &/$var-bindings #(&/|put id (&/$Some type) %)
+ ts))
state)
nil))
- ((&/fail-with-loc (str "[Type Error] Unknown type-var: " id " | " (->> state (&/get$ &/$type-vars) (&/get$ &/$mappings) &/|length)))
+ ((&/fail-with-loc (str "[Type Error] Unknown type-var: " id " | " (->> state (&/get$ &/$type-context) (&/get$ &/$var-bindings) &/|length)))
state))))
(defn reset-var [id type]
(fn [state]
- (if-let [tvar (->> state (&/get$ &/$type-vars) (&/get$ &/$mappings) (&/|get id))]
- (return* (&/update$ &/$type-vars (fn [ts] (&/update$ &/$mappings #(&/|put id (&/$Some type) %)
- ts))
+ (if-let [tvar (->> state (&/get$ &/$type-context) (&/get$ &/$var-bindings) (&/|get id))]
+ (return* (&/update$ &/$type-context (fn [ts] (&/update$ &/$var-bindings #(&/|put id (&/$Some type) %)
+ ts))
state)
nil)
- ((&/fail-with-loc (str "[Type Error] Unknown type-var: " id " | " (->> state (&/get$ &/$type-vars) (&/get$ &/$mappings) &/|length)))
+ ((&/fail-with-loc (str "[Type Error] Unknown type-var: " id " | " (->> state (&/get$ &/$type-context) (&/get$ &/$var-bindings) &/|length)))
state))))
(defn unset-var [id]
(fn [state]
- (if-let [tvar (->> state (&/get$ &/$type-vars) (&/get$ &/$mappings) (&/|get id))]
- (return* (&/update$ &/$type-vars (fn [ts] (&/update$ &/$mappings #(&/|put id &/$None %)
- ts))
+ (if-let [tvar (->> state (&/get$ &/$type-context) (&/get$ &/$var-bindings) (&/|get id))]
+ (return* (&/update$ &/$type-context (fn [ts] (&/update$ &/$var-bindings #(&/|put id &/$None %)
+ ts))
state)
nil)
- ((&/fail-with-loc (str "[Type Error] Unknown type-var: " id " | " (->> state (&/get$ &/$type-vars) (&/get$ &/$mappings) &/|length)))
+ ((&/fail-with-loc (str "[Type Error] Unknown type-var: " id " | " (->> state (&/get$ &/$type-context) (&/get$ &/$var-bindings) &/|length)))
state))))
;; [Exports]
;; Type vars
(def reset-mappings
(fn [state]
- (return* (&/update$ &/$type-vars #(->> %
- ;; (&/set$ &/$counter 0)
- (&/set$ &/$mappings (&/|table)))
+ (return* (&/update$ &/$type-context #(->> %
+ ;; (&/set$ &/$var-counter 0)
+ (&/set$ &/$var-bindings (&/|table)))
state)
nil)))
(def create-var
(fn [state]
- (let [id (->> state (&/get$ &/$type-vars) (&/get$ &/$counter))]
- (return* (&/update$ &/$type-vars #(->> %
- (&/update$ &/$counter inc)
- (&/update$ &/$mappings (fn [ms] (&/|put id &/$None ms))))
+ (let [id (->> state (&/get$ &/$type-context) (&/get$ &/$var-counter))]
+ (return* (&/update$ &/$type-context #(->> %
+ (&/update$ &/$var-counter inc)
+ (&/update$ &/$var-bindings (fn [ms] (&/|put id &/$None ms))))
state)
id))))
(def existential
;; (Lux Type)
- (|do [seed &/gen-id]
- (return (&/$ExT seed))))
+ (fn [compiler]
+ (return* (&/update$ &/$type-context
+ (fn [context]
+ (&/update$ &/$ex-counter inc context))
+ compiler)
+ (->> compiler
+ (&/get$ &/$type-context)
+ (&/get$ &/$ex-counter)
+ &/$ExT))))
(declare clean*)
(defn delete-var [id]
@@ -292,9 +299,9 @@
(|do [?type** (clean* id ?type*)]
(return (&/T [?id (&/$Some ?type**)]))))
))))
- (->> state (&/get$ &/$type-vars) (&/get$ &/$mappings)))]
+ (->> state (&/get$ &/$type-context) (&/get$ &/$var-bindings)))]
(fn [state]
- (return* (&/update$ &/$type-vars #(&/set$ &/$mappings (&/|remove id mappings*) %)
+ (return* (&/update$ &/$type-context #(&/set$ &/$var-bindings (&/|remove id mappings*) %)
state)
nil)))
state))))