diff options
Diffstat (limited to '')
| -rw-r--r-- | src/lux/analyser/case.clj | 11 | ||||
| -rw-r--r-- | src/lux/analyser/lux.clj | 22 | ||||
| -rw-r--r-- | src/lux/type.clj | 4 |
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] |