From 3d18954a2307b48c955f5bdd3790a92ffeb7284c Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 16 Aug 2015 13:28:07 -0400 Subject: Unified tuples & records. --- src/lux/analyser/case.clj | 27 +++------------------ src/lux/analyser/lux.clj | 2 +- src/lux/analyser/module.clj | 2 +- src/lux/base.clj | 14 ++++------- src/lux/compiler/type.clj | 7 ------ src/lux/type.clj | 57 ++++++++++----------------------------------- 6 files changed, 22 insertions(+), 87 deletions(-) (limited to 'src') diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj index 148e2822a..395ae6976 100644 --- a/src/lux/analyser/case.clj +++ b/src/lux/analyser/case.clj @@ -89,21 +89,6 @@ up)) ?members*)))) - (&/$RecordT ?members) - (|do [(&/$RecordT ?members*) (&/fold% (fn [_abody ena] - (|let [[_aenv _aname _aarg (&/$VarT _avar)] ena] - (|do [_ (&type/set-var _avar (&/V &/$BoundT _aarg))] - (&type/clean* _avar _abody)))) - type - up)] - (return (&/V &/$RecordT (&/|map (fn [v] - (&/fold (fn [_abody ena] - (|let [[_aenv _aname _aarg _avar] ena] - (&/V &/$AllT (&/T _aenv _aname _aarg _abody)))) - v - up)) - ?members*)))) - (&/$VariantT ?members) (|do [(&/$VariantT ?members*) (&/fold% (fn [_abody ena] (|let [[_aenv _aname _aarg (&/$VarT _avar)] ena] @@ -128,8 +113,8 @@ (fail "##9##")))] (adjust-type* up type*)) - ;; [_] - ;; (assert false (aget type 0)) + _ + (assert false (prn 'adjust-type* (&type/show-type type))) )) (defn adjust-type [type] @@ -201,7 +186,7 @@ ;; value-type* (resolve-type value-type) ] (|case value-type* - (&/$RecordT ?member-types) + (&/$TupleT ?member-types) (if (not (.equals ^Object (&/|length ?member-types) (&/|length ?members))) (fail (str "[Pattern-matching Error] Pattern-matching mismatch. Require record[" (&/|length ?member-types) "]. Given record[" (&/|length ?members) "]")) (|do [[=tests =kont] (&/fold (fn [kont* vm] @@ -374,12 +359,6 @@ ?structs ?members)] (return (&/fold #(and %1 %2) true totals))) - (&/$RecordT ?members) - (|do [totals (&/map2% (fn [sub-struct ?member] - (check-totality ?member sub-struct)) - ?structs ?members)] - (return (&/fold #(and %1 %2) true totals))) - _ (fail "[Pattern-maching Error] Tuple is not total.")))) diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index 449ef59c1..79b804088 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -147,7 +147,7 @@ _ (&type/actual-type exo-type)) types (|case exo-type* - (&/$RecordT ?table) + (&/$TupleT ?table) (return ?table) _ diff --git a/src/lux/analyser/module.clj b/src/lux/analyser/module.clj index 6cf25b738..08ad0b9a5 100644 --- a/src/lux/analyser/module.clj +++ b/src/lux/analyser/module.clj @@ -22,7 +22,7 @@ "imports" "tags") (def ^:private +init+ - (&/R ;; "lux;module-aliases" + (&/T ;; "lux;module-aliases" (&/|table) ;; "lux;defs" (&/|table) diff --git a/src/lux/base.clj b/src/lux/base.clj index 89620ce97..e39f76409 100644 --- a/src/lux/base.clj +++ b/src/lux/base.clj @@ -51,9 +51,8 @@ ;; Type (deftags "" "DataT" - "TupleT" "VariantT" - "RecordT" + "TupleT" "LambdaT" "BoundT" "VarT" @@ -113,9 +112,6 @@ (defn V [^Long tag value] (to-array [tag value])) -(defn R [& kvs] - (to-array kvs)) - ;; Constructors (def None$ (V $None nil)) (defn Some$ [x] (V $Some x)) @@ -551,13 +547,13 @@ (return* state (->> state (get$ $host) (get$ $classes))))) (def +init-bindings+ - (R ;; "lux;counter" + (T ;; "lux;counter" 0 ;; "lux;mappings" (|table))) (defn env [name] - (R ;; "lux;name" + (T ;; "lux;name" name ;; "lux;inner-closures" 0 @@ -587,7 +583,7 @@ (defn host [_] (let [store (atom {})] - (R ;; "lux;writer" + (T ;; "lux;writer" (V $None nil) ;; "lux;loader" (memory-class-loader store) @@ -595,7 +591,7 @@ store))) (defn init-state [_] - (R ;; "lux;source" + (T ;; "lux;source" (V $None nil) ;; "lux;cursor" (T "" -1 -1) diff --git a/src/lux/compiler/type.clj b/src/lux/compiler/type.clj index 3d2ef5070..a7c5176ad 100644 --- a/src/lux/compiler/type.clj +++ b/src/lux/compiler/type.clj @@ -58,13 +58,6 @@ $Nil (&/|reverse ?members))) - (&/$RecordT ?members) - (variant$ &/$RecordT - (&/fold (fn [tail head] - (Cons$ (->analysis head) tail)) - $Nil - (&/|reverse ?members))) - (&/$LambdaT ?input ?output) (variant$ &/$LambdaT (tuple$ (&/|list (->analysis ?input) (->analysis ?output)))) diff --git a/src/lux/type.clj b/src/lux/type.clj index 92c986985..2516fbc1d 100644 --- a/src/lux/type.clj +++ b/src/lux/type.clj @@ -55,10 +55,6 @@ ;; (assert (|list? members)) (&/V &/$VariantT members)) -(defn Record$ [members] - ;; (assert (|list? members)) - (&/V &/$RecordT members)) - (defn All$ [env name arg body] (&/V &/$AllT (&/T env name arg body))) @@ -95,11 +91,9 @@ (Variant$ (&/|list ;; DataT Text - ;; TupleT - (App$ List Type) ;; VariantT TypeList - ;; RecordT + ;; TupleT TypeList ;; LambdaT TypePair @@ -119,20 +113,20 @@ (def Bindings (All$ empty-env "lux;Bindings" "k" (All$ no-env "" "v" - (Record$ (&/|list - ;; "lux;counter" - Int - ;; "lux;mappings" - (App$ List - (Tuple$ (&/|list (Bound$ "k") - (Bound$ "v"))))))))) + (Tuple$ (&/|list + ;; "lux;counter" + Int + ;; "lux;mappings" + (App$ List + (Tuple$ (&/|list (Bound$ "k") + (Bound$ "v"))))))))) (def Env (let [bindings (App$ (App$ Bindings (Bound$ "k")) (Bound$ "v"))] (All$ empty-env "lux;Env" "k" (All$ no-env "" "v" - (Record$ + (Tuple$ (&/|list ;; "lux;name" Text @@ -215,7 +209,7 @@ Text))) (def Host - (Record$ + (Tuple$ (&/|list ;; "lux;writer" (Data$ "org.objectweb.asm.ClassWriter") @@ -246,7 +240,7 @@ (def $Module (All$ empty-env "lux;$Module" "Compiler" - (Record$ + (Tuple$ (&/|list ;; "lux;module-aliases" (App$ List (Tuple$ (&/|list Text Text))) @@ -271,7 +265,7 @@ (def $Compiler (App$ (All$ empty-env "lux;Compiler" "" - (Record$ + (Tuple$ (&/|list ;; "lux;source" Source @@ -426,10 +420,6 @@ (|do [=members (&/map% (partial clean* ?tid) ?members)] (return (Variant$ =members))) - (&/$RecordT ?members) - (|do [=members (&/map% (partial clean* ?tid) ?members)] - (return (Record$ =members))) - (&/$AllT ?env ?name ?arg ?body) (|do [=env (|case ?env (&/$None) @@ -492,13 +482,6 @@ (&/|interpose " ") (&/fold str "")) ")")) - - (&/$RecordT fields) - (str "(& " (->> fields - (&/|map show-type) - (&/|interpose " ") - (&/fold str "")) ")") - (&/$LambdaT input output) (|let [[?out ?ins] (unravel-fun type)] (str "(-> " (->> ?ins (&/|map show-type) (&/|interpose " ") (&/fold str "")) " " (show-type ?out) ")")) @@ -548,11 +531,6 @@ true xcases ycases) - [(&/$RecordT xslots) (&/$RecordT yslots)] - (&/fold2 (fn [old x y] (and old (type= x y))) - true - xslots yslots) - [(&/$LambdaT xinput xoutput) (&/$LambdaT yinput youtput)] (and (type= xinput yinput) (type= xoutput youtput)) @@ -619,9 +597,6 @@ (&/$VariantT ?members) (Variant$ (&/|map (partial beta-reduce env) ?members)) - (&/$RecordT ?members) - (Record$ (&/|map (partial beta-reduce env) ?members)) - (&/$TupleT ?members) (Tuple$ (&/|map (partial beta-reduce env) ?members)) @@ -890,14 +865,6 @@ e!cases a!cases)] (return (&/T fixpoints* nil))) - [(&/$RecordT e!slots) (&/$RecordT a!slots)] - (|do [fixpoints* (&/fold2% (fn [fp e a] - (|do [[fp* _] (check* class-loader fp e a)] - (return fp*))) - fixpoints - e!slots a!slots)] - (return (&/T fixpoints* nil))) - [(&/$ExT e!id) (&/$ExT a!id)] (if (.equals ^Object e!id a!id) (return (&/T fixpoints nil)) -- cgit v1.2.3