aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorEduardo Julian2015-08-23 20:27:51 -0400
committerEduardo Julian2015-08-23 20:27:51 -0400
commit37a9044d8ec523a282c0470d65380ce5cff27084 (patch)
tree78a04d8465f5932e29c0bc66b13798aff8a08632 /src
parent82b019a5b5f547f3b321642ce687d8aec59e802e (diff)
- Restructuring how sums & products work [part 3]
Diffstat (limited to 'src')
-rw-r--r--src/lux/analyser/case.clj11
-rw-r--r--src/lux/analyser/lux.clj22
-rw-r--r--src/lux/type.clj4
3 files changed, 19 insertions, 18 deletions
diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj
index 212f02665..6bb767d3e 100644
--- a/src/lux/analyser/case.clj
+++ b/src/lux/analyser/case.clj
@@ -120,8 +120,8 @@
(return ($$ &/P idx (&/|length group) case-type))))
(defn ^:private analyse-pattern [value-type pattern kont]
- (|let [[_ pattern*] pattern
- ;; :let [_ (prn 'analyse-pattern (&/adt->text pattern*) (&type/show-type value-type))]
+ (|let [[meta pattern*] pattern
+ ;; _ (prn 'analyse-pattern (&/show-ast pattern) (&type/show-type value-type))
]
(|case pattern*
(&/$SymbolS "" name)
@@ -130,9 +130,6 @@
idx &env/next-local-idx]
(return (&/P (&/S $StoreTestAC idx) =kont)))
- (&/$SymbolS ident)
- (fail (str "[Pattern-matching Error] Symbols must be unqualified: " (&/ident->text ident)))
-
(&/$BoolS ?value)
(|do [_ (&type/check value-type &type/Bool)
=kont kont]
@@ -176,7 +173,7 @@
(fail "[Pattern-matching Error] Pattern-matching mismatch. Tuple has wrong size.")
_
- (analyse-pattern ?right (&/S &/$TupleS ?tail) kont))]
+ (analyse-pattern ?right (&/P meta (&/S &/$TupleS ?tail)) kont))]
(return (&/P =right =kont))))]
(return (&/P (&/S $ProdTestAC (&/P =left =right)) =kont)))
@@ -185,7 +182,7 @@
(&/$RecordS pairs)
(|do [?members (&&record/order-record pairs)]
- (analyse-pattern value-type (&/S &/$TupleS ?members) kont))
+ (analyse-pattern value-type (&/P meta (&/S &/$TupleS ?members)) kont))
(&/$TagS ?ident)
(|do [[idx group-count case-type] (resolve-tag ?ident value-type)
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index f7ed07ee4..20e435eb3 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -209,7 +209,11 @@
(&/|list))
(&/|reverse inner) scopes)]
((|do [btype (&&/expr-type =local)
- _ (&type/check exo-type btype)]
+ ;; :let [_ (prn 'analyse-local/_0 name)
+ ;; _ (prn 'analyse-local/_1 name (&type/show-type exo-type) (&type/show-type btype))]
+ _ (&type/check exo-type btype)
+ ;; :let [_ (prn 'analyse-local/_2 name 'CHECKED)]
+ ]
(return (&/|list =local)))
(&/$set-envs (&/|++ inner* outer) state))))
))))
@@ -273,14 +277,14 @@
macro-expansion #(-> macro (.apply ?args) (.apply %))
;; :let [_ (prn 'MACRO-EXPAND|POST (&/ident->text real-name))]
;; :let [macro-expansion* (&/|map (partial with-cursor form-cursor) macro-expansion)]
- ;; :let [_ (when (or (= "defsig" (aget real-name 1))
- ;; ;; (= "type" (aget real-name 1))
- ;; ;; (= &&/$struct r-name)
- ;; )
- ;; (->> (&/|map &/show-ast macro-expansion)
- ;; (&/|interpose "\n")
- ;; (&/fold str "")
- ;; (prn (&/ident->text real-name))))]
+ :let [_ (when (or (= "using" (aget real-name 1))
+ ;; (= "type" (aget real-name 1))
+ ;; (= &&/$struct r-name)
+ )
+ (->> (&/|map &/show-ast macro-expansion)
+ (&/|interpose "\n")
+ (&/fold str "")
+ (prn (&/ident->text real-name))))]
]
(&/flat-map% (partial analyse exo-type) macro-expansion))
diff --git a/src/lux/type.clj b/src/lux/type.clj
index 91bc6e480..37f3a99d4 100644
--- a/src/lux/type.clj
+++ b/src/lux/type.clj
@@ -685,7 +685,7 @@
(apply-type ?type param)
_
- (fail (str "[Type System] Not a type function:\n" (show-type type-fn) "\n"))))
+ (fail (str "[Type Error] Not a type function:\n" (show-type type-fn) "\n"))))
(defn as-obj [class]
(case class
@@ -947,7 +947,7 @@
(apply-lambda ?type param)
_
- (fail (str "[Type System] Not a function type:\n" (show-type func) "\n"))
+ (fail (str "[Type Error] Not a function type:\n" (show-type func) "\n"))
))
(defn actual-type [type]