diff options
author | Eduardo Julian | 2015-07-26 20:57:21 -0400 |
---|---|---|
committer | Eduardo Julian | 2015-07-26 20:57:21 -0400 |
commit | 9b7cfd6f5bcc93e2f2f0c3129b7ec6d62c69bb37 (patch) | |
tree | 186f2fb0f81589df819c87d37ba4a6f0961ebdc4 /src | |
parent | 4cd9b0c9242f1105e50ad9b42b7f6f5d074f14b4 (diff) |
- Fixed a pattern-matching error where generalizations of types (universal-quantification / AllT) was not being taken into account properly when destructuring.
- Fixed a compiler error wherein the types of definitions didn't generate (correctly) the structures necessary for storage inside the class _meta(data) field.
- Improved both the "open" and "import" macros with extra features.
Diffstat (limited to '')
-rw-r--r-- | src/lux/analyser/case.clj | 120 | ||||
-rw-r--r-- | src/lux/analyser/lux.clj | 18 | ||||
-rw-r--r-- | src/lux/compiler/base.clj | 1 | ||||
-rw-r--r-- | src/lux/compiler/cache.clj | 2 | ||||
-rw-r--r-- | src/lux/compiler/host.clj | 2 | ||||
-rw-r--r-- | src/lux/compiler/lambda.clj | 2 | ||||
-rw-r--r-- | src/lux/compiler/lux.clj | 113 | ||||
-rw-r--r-- | src/lux/compiler/type.clj | 97 | ||||
-rw-r--r-- | src/lux/type.clj | 20 |
9 files changed, 234 insertions, 141 deletions
diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj index 659b2b0f6..cb76d8d54 100644 --- a/src/lux/analyser/case.clj +++ b/src/lux/analyser/case.clj @@ -23,7 +23,8 @@ (fail "##9##")))] (resolve-type type*)) - [["lux;AllT" ?id]] + [["lux;AllT" [_aenv _aname _aarg _abody]]] + ;; (&type/actual-type _abody) (|do [$var &type/existential =type (&type/apply-type type $var)] (&type/actual-type =type)) @@ -35,6 +36,79 @@ [_] (&type/actual-type type))) +(defn adjust-type* [up type] + "(-> (List (, (Maybe (Env Text Type)) Text Text Type)) Type (Lux Type))" + (matchv ::M/objects [type] + [["lux;AllT" [_aenv _aname _aarg _abody]]] + (&type/with-var + (fn [$var] + (|do [=type (&type/apply-type type $var)] + (adjust-type* (&/|cons (&/T _aenv _aname _aarg $var) up) =type)))) + + [["lux;TupleT" ?members]] + (|do [["lux;TupleT" ?members*] (&/fold% (fn [_abody ena] + (|let [[_aenv _aname _aarg ["lux;VarT" _avar]] ena] + (|do [_ (&type/set-var _avar (&/V "lux;BoundT" _aarg))] + (&type/clean* _avar _abody)))) + type + up)] + (return (&/V "lux;TupleT" (&/|map (fn [v] + (&/fold (fn [_abody ena] + (|let [[_aenv _aname _aarg _avar] ena] + (&/V "lux;AllT" (&/T _aenv _aname _aarg _abody)))) + v + up)) + ?members*)))) + + [["lux;RecordT" ?fields]] + (|do [["lux;RecordT" ?fields*] (&/fold% (fn [_abody ena] + (|let [[_aenv _aname _aarg ["lux;VarT" _avar]] ena] + (|do [_ (&type/set-var _avar (&/V "lux;BoundT" _aarg))] + (&type/clean* _avar _abody)))) + type + up)] + (return (&/V "lux;RecordT" (&/|map (fn [kv] + (|let [[k v] kv] + (&/T k (&/fold (fn [_abody ena] + (|let [[_aenv _aname _aarg _avar] ena] + (&/V "lux;AllT" (&/T _aenv _aname _aarg _abody)))) + v + up)))) + ?fields*)))) + + [["lux;VariantT" ?cases]] + (|do [["lux;VariantT" ?cases*] (&/fold% (fn [_abody ena] + (|let [[_aenv _aname _aarg ["lux;VarT" _avar]] ena] + (|do [_ (&type/set-var _avar (&/V "lux;BoundT" _aarg))] + (&type/clean* _avar _abody)))) + type + up)] + (return (&/V "lux;VariantT" (&/|map (fn [kv] + (|let [[k v] kv] + (&/T k (&/fold (fn [_abody ena] + (|let [[_aenv _aname _aarg _avar] ena] + (&/V "lux;AllT" (&/T _aenv _aname _aarg _abody)))) + v + up)))) + ?cases*)))) + + [["lux;AppT" [?tfun ?targ]]] + (|do [=type (&type/apply-type ?tfun ?targ)] + (adjust-type* up =type)) + + [["lux;VarT" ?id]] + (|do [type* (&/try-all% (&/|list (&type/deref ?id) + (fail "##9##")))] + (adjust-type* up type*)) + + [_] + (assert false (aget type 0)) + )) + +(defn adjust-type [type] + "(-> Type (Lux Type))" + (adjust-type* (&/|list) type)) + (defn ^:private analyse-pattern [value-type pattern kont] (matchv ::M/objects [pattern] [["lux;Meta" [_ pattern*]]] @@ -71,27 +145,31 @@ (return (&/T (&/V "TextTestAC" ?value) =kont))) [["lux;TupleS" ?members]] - (|do [value-type* (resolve-type value-type)] + (|do [value-type* (adjust-type value-type)] (do ;; (prn 'PM/TUPLE-1 (&type/show-type value-type*)) - (matchv ::M/objects [value-type*] - [["lux;TupleT" ?member-types]] - (do ;; (prn 'PM/TUPLE-2 (&/|length ?member-types) (&/|length ?members)) - (if (not (.equals ^Object (&/|length ?member-types) (&/|length ?members))) - (fail (str "[Pattern-matching Error] Pattern-matching mismatch. Require tuple[" (&/|length ?member-types) "]. Given tuple [" (&/|length ?members) "]")) - (|do [[=tests =kont] (&/fold (fn [kont* vm] - (|let [[v m] vm] - (|do [[=test [=tests =kont]] (analyse-pattern v m kont*)] - (return (&/T (&/|cons =test =tests) =kont))))) - (|do [=kont kont] - (return (&/T (&/|list) =kont))) - (&/|reverse (&/zip2 ?member-types ?members)))] - (return (&/T (&/V "TupleTestAC" =tests) =kont))))) - - [_] - (fail (str "[Pattern-matching Error] Tuples require tuple-types: " (&type/show-type value-type*)))))) + (matchv ::M/objects [value-type*] + [["lux;TupleT" ?member-types]] + (do ;; (prn 'PM/TUPLE-2 (&/|length ?member-types) (&/|length ?members)) + (if (not (.equals ^Object (&/|length ?member-types) (&/|length ?members))) + (fail (str "[Pattern-matching Error] Pattern-matching mismatch. Require tuple[" (&/|length ?member-types) "]. Given tuple [" (&/|length ?members) "]")) + (|do [[=tests =kont] (&/fold (fn [kont* vm] + (|let [[v m] vm] + (|do [[=test [=tests =kont]] (analyse-pattern v m kont*)] + (return (&/T (&/|cons =test =tests) =kont))))) + (|do [=kont kont] + (return (&/T (&/|list) =kont))) + (&/|reverse (&/zip2 ?member-types ?members)))] + (return (&/T (&/V "TupleTestAC" =tests) =kont))))) + + [_] + (fail (str "[Pattern-matching Error] Tuples require tuple-types: " (&type/show-type value-type*)))))) [["lux;RecordS" ?slots]] - (|do [value-type* (resolve-type value-type)] + (|do [;; :let [_ (prn 'PRE (&type/show-type value-type))] + value-type* (adjust-type value-type) + ;; :let [_ (prn 'POST (&type/show-type value-type*))] + ;; value-type* (resolve-type value-type) + ] (matchv ::M/objects [value-type*] [["lux;RecordT" ?slot-types]] (if (not (.equals ^Object (&/|length ?slot-types) (&/|length ?slots))) @@ -118,7 +196,7 @@ [["lux;TagS" ?ident]] (|do [=tag (&&/resolved-ident ?ident) - value-type* (resolve-type value-type) + value-type* (adjust-type value-type) case-type (&type/variant-case =tag value-type*) [=test =kont] (analyse-pattern case-type (&/V "lux;Meta" (&/T (&/T "" -1 -1) (&/V "lux;TupleS" (&/|list)))) @@ -129,7 +207,7 @@ ["lux;Cons" [?value ["lux;Nil" _]]]]]]] (|do [=tag (&&/resolved-ident ?ident) - value-type* (resolve-type value-type) + value-type* (adjust-type value-type) case-type (&type/variant-case =tag value-type*) [=test =kont] (analyse-pattern case-type ?value kont)] diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index b25dff9eb..4a912f1c1 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -219,7 +219,7 @@ [["lux;Cons" [?arg ?args*]]] (|do [?fun-type* (&type/actual-type fun-type)] (matchv ::M/objects [?fun-type*] - [["lux;AllT" _]] + [["lux;AllT" [_aenv _aname _aarg _abody]]] ;; (|do [$var &type/existential ;; type* (&type/apply-type ?fun-type* $var)] ;; (analyse-apply* analyse exo-type type* ?args)) @@ -230,11 +230,10 @@ (matchv ::M/objects [$var] [["lux;VarT" ?id]] (|do [? (&type/bound? ?id) - _ (if ? - (return nil) - (|do [ex &type/existential] - (&type/set-var ?id ex))) - type** (&type/clean $var =output-t)] + type** (if ? + (&type/clean $var =output-t) + (|do [_ (&type/set-var ?id (&/V "lux;BoundT" _aarg))] + (&type/clean $var =output-t)))] (return (&/T type** =args))) )))) @@ -262,11 +261,11 @@ (|do [macro-expansion #(-> macro (.apply ?args) (.apply %)) :let [macro-expansion* (&/|map (partial with-cursor form-cursor) macro-expansion)] ;; :let [_ (when (and ;; (= "lux/control/monad" ?module) - ;; (= "case" ?name)) + ;; (= "open" ?name)) ;; (->> (&/|map &/show-ast macro-expansion*) ;; (&/|interpose "\n") ;; (&/fold str "") - ;; (prn ?module "case")))] + ;; (prn ?module "open")))] ] (&/flat-map% (partial analyse exo-type) macro-expansion*)) @@ -328,6 +327,9 @@ ;; dtype* (&type/actual-type dtype) ] (matchv ::M/objects [dtype] + [["lux;BoundT" ?vname]] + (return (&/T _expr exo-type)) + [["lux;ExT" _]] (return (&/T _expr exo-type)) diff --git a/src/lux/compiler/base.clj b/src/lux/compiler/base.clj index e7b338b16..0631f51e8 100644 --- a/src/lux/compiler/base.clj +++ b/src/lux/compiler/base.clj @@ -29,6 +29,7 @@ (def ^String version "0.2") (def ^String input-dir "source") (def ^String output-dir "target/jvm") +(def ^String function-class "lux/Function") (def ^String local-prefix "l") (def ^String partial-prefix "p") diff --git a/src/lux/compiler/cache.clj b/src/lux/compiler/cache.clj index d6f0b1db7..57e81a2b0 100644 --- a/src/lux/compiler/cache.clj +++ b/src/lux/compiler/cache.clj @@ -55,7 +55,7 @@ (defn clean [state] "(-> Compiler (,))" (let [needed-modules (->> state (&/get$ &/$MODULES) &/|keys &/->seq set) - outdated? #(-> % .getName (string/replace " " "/") (->> (contains? needed-modules)) not) + outdated? #(-> ^File % .getName (string/replace " " "/") (->> (contains? needed-modules)) not) outdate-files (->> &&/output-dir (new File) .listFiles seq (filter outdated?))] (doseq [f outdate-files] (clean-file f)) diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj index fd34a45a7..3df09b29e 100644 --- a/src/lux/compiler/host.clj +++ b/src/lux/compiler/host.clj @@ -593,7 +593,7 @@ _ (compile ?body) :let [_ (doto main-writer (.visitInsn Opcodes/ACONST_NULL) - (.visitMethodInsn Opcodes/INVOKEINTERFACE "lux/Function" "apply" &&/apply-signature))] + (.visitMethodInsn Opcodes/INVOKEINTERFACE &&/function-class "apply" &&/apply-signature))] :let [_ (doto main-writer (.visitInsn Opcodes/POP) (.visitInsn Opcodes/RETURN) diff --git a/src/lux/compiler/lambda.clj b/src/lux/compiler/lambda.clj index d97cc1f26..ccd12e68a 100644 --- a/src/lux/compiler/lambda.clj +++ b/src/lux/compiler/lambda.clj @@ -97,7 +97,7 @@ class-name (str (&host/->module-class (&/|head ?scope)) "/" name) =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_SUPER) - class-name nil "java/lang/Object" (into-array ["lux/Function"])) + class-name nil "java/lang/Object" (into-array [&&/function-class])) (-> (doto (.visitField (+ Opcodes/ACC_PRIVATE Opcodes/ACC_FINAL) captured-name clo-field-sig nil nil) (.visitEnd)) (->> (let [captured-name (str &&/closure-prefix ?captured-id)]) diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj index 32a7af751..f1c261d6b 100644 --- a/src/lux/compiler/lux.clj +++ b/src/lux/compiler/lux.clj @@ -21,7 +21,8 @@ (lux.analyser [base :as &a] [module :as &a-module]) (lux.compiler [base :as &&] - [lambda :as &&lambda])) + [lambda :as &&lambda] + [type :as &&type])) (:import (org.objectweb.asm Opcodes Label ClassWriter @@ -63,7 +64,10 @@ (|do [:let [_ (doto *writer* (.visitInsn Opcodes/DUP) (.visitLdcInsn (int idx)))] - ret (compile elem) + ret (try (compile elem) + (catch Exception e + (prn 'compile-tuple (aget elem 0) (->> ?elems (&/|map #(aget % 0)) &/->seq)) + (throw e))) :let [_ (.visitInsn *writer* Opcodes/AASTORE)]] (return ret))) (&/|range num-elems) ?elems)] @@ -130,110 +134,11 @@ _ (compile ?fn) _ (&/map% (fn [?arg] (|do [=arg (compile ?arg) - :let [_ (.visitMethodInsn *writer* Opcodes/INVOKEINTERFACE "lux/Function" "apply" &&/apply-signature)]] + :let [_ (.visitMethodInsn *writer* Opcodes/INVOKEINTERFACE &&/function-class "apply" &&/apply-signature)]] (return =arg))) ?args)] (return nil))) -(defn ^:private type->analysis [type] - (matchv ::M/objects [type] - [["lux;DataT" ?class]] - (&/T (&/V "variant" (&/T "lux;DataT" - (&/T (&/V "text" ?class) &type/$Void))) - &type/$Void) - - [["lux;TupleT" ?members]] - (&/T (&/V "variant" (&/T "lux;TupleT" - (&/fold (fn [tail head] - (&/V "variant" (&/T "lux;Cons" - (&/T (&/V "tuple" (&/|list (type->analysis head) - tail)) - &type/$Void)))) - (&/V "variant" (&/T "lux;Nil" - (&/T (&/V "tuple" (&/|list)) - &type/$Void))) - (&/|reverse ?members)))) - &type/$Void) - - [["lux;VariantT" ?cases]] - (&/T (&/V "variant" (&/T "lux;VariantT" - (&/fold (fn [tail head] - (|let [[hlabel htype] head] - (&/V "variant" (&/T "lux;Cons" - (&/T (&/V "tuple" (&/|list (&/T (&/V "tuple" (&/|list (&/T (&/V "text" hlabel) &type/$Void) - (type->analysis htype))) - &type/$Void) - tail)) - &type/$Void))))) - (&/V "variant" (&/T "lux;Nil" - (&/T (&/V "tuple" (&/|list)) - &type/$Void))) - (&/|reverse ?cases)))) - &type/$Void) - - [["lux;RecordT" ?slots]] - (&/T (&/V "variant" (&/T "lux;RecordT" - (&/fold (fn [tail head] - (|let [[hlabel htype] head] - (&/V "variant" (&/T "lux;Cons" - (&/T (&/V "tuple" (&/|list (&/T (&/V "tuple" (&/|list (&/T (&/V "text" hlabel) &type/$Void) - (type->analysis htype))) - &type/$Void) - tail)) - &type/$Void))))) - (&/V "variant" (&/T "lux;Nil" - (&/T (&/V "tuple" (&/|list)) - &type/$Void))) - (&/|reverse ?slots)))) - &type/$Void) - - [["lux;LambdaT" [?input ?output]]] - (&/T (&/V "variant" (&/T "lux;LambdaT" - (&/T (&/V "tuple" (&/|map type->analysis (&/|list ?input ?output))) - &type/$Void))) - &type/$Void) - - [["lux;AllT" [?env ?name ?arg ?body]]] - (&/T (&/V "variant" (&/T "lux;AllT" - (&/T (&/V "tuple" (&/|list (matchv ::M/objects [?env] - [["lux;None" _]] - (&/V "variant" (&/T "lux;Some" - (&/T (&/V "tuple" (&/|list)) - &type/$Void))) - - [["lux;Some" ??env]] - (&/V "variant" (&/T "lux;Some" - (&/T (&/fold (fn [tail head] - (|let [[hlabel htype] head] - (&/V "variant" (&/T "lux;Cons" - (&/T (&/V "tuple" (&/|list (&/T (&/V "tuple" (&/|list (&/T (&/V "text" hlabel) &type/$Void) - (type->analysis htype))) - &type/$Void) - tail)) - &type/$Void))))) - (&/V "variant" (&/T "lux;Nil" - (&/T (&/V "tuple" (&/|list)) - &type/$Void))) - (&/|reverse ??env)) - &type/$Void)))) - (&/T (&/V "text" ?name) &type/$Void) - (&/T (&/V "text" ?arg) &type/$Void) - (type->analysis ?body))) - &type/$Void))) - &type/$Void) - - [["lux;BoundT" ?name]] - (&/T (&/V "variant" (&/T "lux;BoundT" - (&/T (&/V "text" ?name) &type/$Void))) - &type/$Void) - - [["lux;AppT" [?fun ?arg]]] - (&/T (&/V "variant" (&/T "lux;AppT" - (&/T (&/V "tuple" (&/|map type->analysis (&/|list ?fun ?arg))) - &type/$Void))) - &type/$Void) - )) - (defn ^:private compile-def-type [compile ?body ?def-data] (|do [^MethodVisitor **writer** &/get-writer] (matchv ::M/objects [?def-data] @@ -260,7 +165,7 @@ (&/T ?def-value ?type-expr) [[?def-value ?def-type]] - (&/T ?body (type->analysis ?def-type)))] + (&/T ?body (&&type/->analysis ?def-type)))] (|do [:let [_ (doto **writer** (.visitLdcInsn (int 2)) ;; S (.visitTypeInsn Opcodes/ANEWARRAY "java/lang/Object") ;; V @@ -284,7 +189,7 @@ current-class (str (&host/->module-class module-name) "/" def-name) =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_SUPER) - current-class nil "java/lang/Object" (into-array ["lux/Function"])) + current-class nil "java/lang/Object" (into-array [&&/function-class])) (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_name" "Ljava/lang/String;" nil ?name) (doto (.visitEnd))) (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_datum" datum-sig nil nil) diff --git a/src/lux/compiler/type.clj b/src/lux/compiler/type.clj new file mode 100644 index 000000000..a92911444 --- /dev/null +++ b/src/lux/compiler/type.clj @@ -0,0 +1,97 @@ +;; Copyright (c) Eduardo Julian. All rights reserved. +;; The use and distribution terms for this software are covered by the +;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +;; which can be found in the file epl-v10.html at the root of this distribution. +;; By using this software in any fashion, you are agreeing to be bound by +;; the terms of this license. +;; You must not remove this notice, or any other, from this software. + +(ns lux.compiler.type + (:require [clojure.core.match :as M :refer [matchv]] + clojure.core.match.array + (lux [base :as & :refer [|do return* return fail fail* |let]] + [type :as &type]))) + +;; [Utils] +(defn ^:private variant$ [tag body] + "(-> Text Analysis Analysis)" + (&/T (&/V "variant" (&/T tag body)) + &type/$Void)) + +(defn ^:private tuple$ [members] + "(-> (List Analysis) Analysis)" + (&/T (&/V "tuple" members) + &type/$Void)) + +(defn ^:private text$ [text] + "(-> Text Analysis)" + (&/T (&/V "text" text) + &type/$Void)) + +(def ^:private $Nil + "Analysis" + (variant$ "lux;Nil" (tuple$ (&/|list)))) + +(defn ^:private Cons$ [head tail] + "(-> Analysis Analysis Analysis)" + (variant$ "lux;Cons" (tuple$ (&/|list head tail)))) + +;; [Exports] +(defn ->analysis [type] + "(-> Type Analysis)" + (matchv ::M/objects [type] + [["lux;DataT" ?class]] + (variant$ "lux;DataT" (text$ ?class)) + + [["lux;TupleT" ?members]] + (variant$ "lux;TupleT" + (&/fold (fn [tail head] + (Cons$ (->analysis head) tail)) + $Nil + (&/|reverse ?members))) + + [["lux;VariantT" ?cases]] + (variant$ "lux;VariantT" + (&/fold (fn [tail head] + (|let [[hlabel htype] head] + (Cons$ (tuple$ (&/|list (text$ hlabel) (->analysis htype))) + tail))) + $Nil + (&/|reverse ?cases))) + + [["lux;RecordT" ?slots]] + (variant$ "lux;RecordT" + (&/fold (fn [tail head] + (|let [[hlabel htype] head] + (Cons$ (tuple$ (&/|list (text$ hlabel) (->analysis htype))) + tail))) + $Nil + (&/|reverse ?slots))) + + [["lux;LambdaT" [?input ?output]]] + (variant$ "lux;LambdaT" (tuple$ (&/|list (->analysis ?input) (->analysis ?output)))) + + [["lux;AllT" [?env ?name ?arg ?body]]] + (variant$ "lux;AllT" + (tuple$ (&/|list (matchv ::M/objects [?env] + [["lux;None" _]] + (variant$ "lux;Some" (tuple$ (&/|list))) + + [["lux;Some" ??env]] + (variant$ "lux;Some" + (&/fold (fn [tail head] + (|let [[hlabel htype] head] + (Cons$ (tuple$ (&/|list (text$ hlabel) (->analysis htype))) + tail))) + $Nil + (&/|reverse ??env)))) + (text$ ?name) + (text$ ?arg) + (->analysis ?body)))) + + [["lux;BoundT" ?name]] + (variant$ "lux;BoundT" (text$ ?name)) + + [["lux;AppT" [?fun ?arg]]] + (variant$ "lux;AppT" (tuple$ (&/|list (->analysis ?fun) (->analysis ?arg)))) + )) diff --git a/src/lux/type.clj b/src/lux/type.clj index f1a5b7623..af2bbf30f 100644 --- a/src/lux/type.clj +++ b/src/lux/type.clj @@ -284,7 +284,7 @@ _ (&/map% delete-var (&/|reverse =vars))] (return output))) -(defn ^:private clean* [?tid type] +(defn clean* [?tid type] (matchv ::M/objects [type] [["lux;VarT" ?id]] (if (.equals ^Object ?tid ?id) @@ -345,6 +345,15 @@ [_] (fail (str "[Type Error] Not type-var: " (show-type tvar))))) +(defn ^:private unravel-fun [type] + (matchv ::M/objects [type] + [["lux;LambdaT" [?in ?out]]] + (|let [[??out ?args] (unravel-fun ?out)] + (&/T ??out (&/|cons ?in ?args))) + + [_] + (&/T type (&/|list)))) + (defn ^:private unravel-app [fun-type] (matchv ::M/objects [fun-type] [["lux;AppT" [?left ?right]]] @@ -389,17 +398,18 @@ (&/fold str "")) ")") [["lux;LambdaT" [input output]]] - (str "(-> " (show-type input) " " (show-type output) ")") + (|let [[?out ?ins] (unravel-fun type)] + (str "(-> " (->> ?ins (&/|map show-type) (&/|interpose " ") (&/fold str "")) " " (show-type ?out) ")")) [["lux;VarT" id]] (str "⌈" id "⌋") - [["lux;BoundT" name]] - name - [["lux;ExT" ?id]] (str "⟨" ?id "⟩") + [["lux;BoundT" name]] + name + [["lux;AppT" [_ _]]] (|let [[?call-fun ?call-args] (unravel-app type)] (str "(" (show-type ?call-fun) " " (->> ?call-args (&/|map show-type) (&/|interpose " ") (&/fold str "")) ")")) |