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. --- source/lux.lux | 331 ++++++++++++++++++++------------------------ 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 ++------ 7 files changed, 174 insertions(+), 266 deletions(-) diff --git a/source/lux.lux b/source/lux.lux index 824113b92..4c4b02f8a 100644 --- a/source/lux.lux +++ b/source/lux.lux @@ -10,7 +10,7 @@ (_jvm_interface "Function" [] ("apply" ["java.lang.Object"] "java.lang.Object" ["public" "abstract"])) -(_lux_declare-tags [#DataT #TupleT #VariantT #RecordT #LambdaT #BoundT #VarT #ExT #AllT #AppT]) +(_lux_declare-tags [#DataT #VariantT #TupleT #LambdaT #BoundT #VarT #ExT #AllT #AppT]) (_lux_declare-tags [#None #Some]) (_lux_declare-tags [#Nil #Cons]) @@ -67,9 +67,8 @@ ## (deftype #rec Type ## (| (#DataT Text) -## (#TupleT (List Type)) ## (#VariantT (List Type)) -## (#RecordT (List Type)) +## (#TupleT (List Type)) ## (#LambdaT Type Type) ## (#BoundT Text) ## (#VarT Int) @@ -85,25 +84,23 @@ (#AppT (#AllT (#Some #Nil) "Type" "_" (#VariantT (#Cons ## "lux;DataT" Text - (#Cons ## "lux;TupleT" + (#Cons ## "lux;VariantT" TypeList - (#Cons ## "lux;VariantT" + (#Cons ## "lux;TupleT" TypeList - (#Cons ## "lux;RecordT" - TypeList - (#Cons ## "lux;LambdaT" - (#TupleT (#Cons Type (#Cons Type #Nil))) - (#Cons ## "lux;BoundT" - Text - (#Cons ## "lux;VarT" + (#Cons ## "lux;LambdaT" + (#TupleT (#Cons Type (#Cons Type #Nil))) + (#Cons ## "lux;BoundT" + Text + (#Cons ## "lux;VarT" + Int + (#Cons ## "lux;ExT" Int - (#Cons ## "lux;ExT" - Int - (#Cons ## "lux;AllT" - (#TupleT (#Cons (#AppT Maybe TypeEnv) (#Cons Text (#Cons Text (#Cons Type #Nil))))) - (#Cons ## "lux;AppT" - (#TupleT (#Cons Type (#Cons Type #Nil))) - #Nil)))))))))))) + (#Cons ## "lux;AllT" + (#TupleT (#Cons (#AppT Maybe TypeEnv) (#Cons Text (#Cons Text (#Cons Type #Nil))))) + (#Cons ## "lux;AppT" + (#TupleT (#Cons Type (#Cons Type #Nil))) + #Nil))))))))))) Void))))) (_lux_export Type) @@ -113,14 +110,14 @@ (_lux_def Bindings (#AllT [(#Some #Nil) "lux;Bindings" "k" (#AllT [#None "" "v" - (#RecordT (#Cons ## "lux;counter" - Int - (#Cons ## "lux;mappings" - (#AppT [List - (#TupleT (#Cons [(#BoundT "k") - (#Cons [(#BoundT "v") - #Nil])]))]) - #Nil)))])])) + (#TupleT (#Cons ## "lux;counter" + Int + (#Cons ## "lux;mappings" + (#AppT [List + (#TupleT (#Cons [(#BoundT "k") + (#Cons [(#BoundT "v") + #Nil])]))]) + #Nil)))])])) (_lux_export Bindings) (_lux_declare-tags [#counter #mappings]) @@ -130,38 +127,38 @@ ## #locals (Bindings k v) ## #closure (Bindings k v))) (_lux_def Env - (#AllT [(#Some #Nil) "lux;Env" "k" - (#AllT [#None "" "v" - (#RecordT (#Cons [## "lux;name" - Text - (#Cons [## "lux;inner-closures" - Int - (#Cons [## "lux;locals" - (#AppT [(#AppT [Bindings (#BoundT "k")]) - (#BoundT "v")]) - (#Cons [## "lux;closure" - (#AppT [(#AppT [Bindings (#BoundT "k")]) - (#BoundT "v")]) - #Nil])])])]))])])) + (#AllT (#Some #Nil) "lux;Env" "k" + (#AllT #None "" "v" + (#TupleT (#Cons ## "lux;name" + Text + (#Cons ## "lux;inner-closures" + Int + (#Cons ## "lux;locals" + (#AppT (#AppT Bindings (#BoundT "k")) + (#BoundT "v")) + (#Cons ## "lux;closure" + (#AppT (#AppT Bindings (#BoundT "k")) + (#BoundT "v")) + #Nil)))))))) (_lux_export Env) (_lux_declare-tags [#name #inner-closures #locals #closure]) ## (deftype Cursor ## (, Text Int Int)) (_lux_def Cursor - (#TupleT (#Cons [Text (#Cons [Int (#Cons [Int #Nil])])]))) + (#TupleT (#Cons Text (#Cons Int (#Cons Int #Nil))))) (_lux_export Cursor) ## (deftype (Meta m v) ## (| (#Meta m v))) (_lux_def Meta - (#AllT [(#Some #Nil) "lux;Meta" "m" - (#AllT [#None "" "v" - (#VariantT (#Cons [## "lux;Meta" - (#TupleT (#Cons [(#BoundT "m") - (#Cons [(#BoundT "v") - #Nil])])) - #Nil]))])])) + (#AllT (#Some #Nil) "lux;Meta" "m" + (#AllT #None "" "v" + (#VariantT (#Cons ## "lux;Meta" + (#TupleT (#Cons (#BoundT "m") + (#Cons (#BoundT "v") + #Nil))) + #Nil))))) (_lux_export Meta) (_lux_declare-tags [#Meta]) @@ -177,60 +174,60 @@ ## (#TupleS (List (w (AST' w)))) ## (#RecordS (List (, (w (AST' w)) (w (AST' w))))))) (_lux_def AST' - (_lux_case (#AppT [(#BoundT "w") - (#AppT [(#BoundT "lux;AST'") - (#BoundT "w")])]) + (_lux_case (#AppT (#BoundT "w") + (#AppT (#BoundT "lux;AST'") + (#BoundT "w"))) AST (_lux_case (#AppT [List AST]) ASTList - (#AllT [(#Some #Nil) "lux;AST'" "w" - (#VariantT (#Cons [## "lux;BoolS" - Bool - (#Cons [## "lux;IntS" - Int - (#Cons [## "lux;RealS" - Real - (#Cons [## "lux;CharS" - Char - (#Cons [## "lux;TextS" - Text - (#Cons [## "lux;SymbolS" - Ident - (#Cons [## "lux;TagS" - Ident - (#Cons [## "lux;FormS" - ASTList - (#Cons [## "lux;TupleS" - ASTList - (#Cons [## "lux;RecordS" - (#AppT [List (#TupleT (#Cons [AST (#Cons [AST #Nil])]))]) - #Nil]) - ])])])])])])])])]) - )])))) + (#AllT (#Some #Nil) "lux;AST'" "w" + (#VariantT (#Cons ## "lux;BoolS" + Bool + (#Cons ## "lux;IntS" + Int + (#Cons ## "lux;RealS" + Real + (#Cons ## "lux;CharS" + Char + (#Cons ## "lux;TextS" + Text + (#Cons ## "lux;SymbolS" + Ident + (#Cons ## "lux;TagS" + Ident + (#Cons ## "lux;FormS" + ASTList + (#Cons ## "lux;TupleS" + ASTList + (#Cons ## "lux;RecordS" + (#AppT List (#TupleT (#Cons AST (#Cons AST #Nil)))) + #Nil) + ))))))))) + ))))) (_lux_export AST') (_lux_declare-tags [#BoolS #IntS #RealS #CharS #TextS #SymbolS #TagS #FormS #TupleS #RecordS]) ## (deftype AST ## (Meta Cursor (AST' (Meta Cursor)))) (_lux_def AST - (_lux_case (#AppT [Meta Cursor]) + (_lux_case (#AppT Meta Cursor) w - (#AppT [w (#AppT [AST' w])]))) + (#AppT w (#AppT AST' w)))) (_lux_export AST) -(_lux_def ASTList (#AppT [List AST])) +(_lux_def ASTList (#AppT List AST)) ## (deftype (Either l r) ## (| (#Left l) ## (#Right r))) (_lux_def Either - (#AllT [(#Some #Nil) "lux;Either" "l" - (#AllT [#None "" "r" - (#VariantT (#Cons [## "lux;Left" - (#BoundT "l") - (#Cons [## "lux;Right" - (#BoundT "r") - #Nil])]))])])) + (#AllT (#Some #Nil) "lux;Either" "l" + (#AllT #None "" "r" + (#VariantT (#Cons ## "lux;Left" + (#BoundT "l") + (#Cons ## "lux;Right" + (#BoundT "r") + #Nil)))))) (_lux_export Either) (_lux_declare-tags [#Left #Right]) @@ -258,13 +255,13 @@ ## #loader (^ java.net.URLClassLoader) ## #classes (^ clojure.lang.Atom))) (_lux_def Host - (#RecordT (#Cons [## "lux;writer" - (#DataT "org.objectweb.asm.ClassWriter") - (#Cons [## "lux;loader" - (#DataT "java.lang.ClassLoader") - (#Cons [## "lux;classes" - (#DataT "clojure.lang.Atom") - #Nil])])]))) + (#TupleT (#Cons [## "lux;writer" + (#DataT "org.objectweb.asm.ClassWriter") + (#Cons [## "lux;loader" + (#DataT "java.lang.ClassLoader") + (#Cons [## "lux;classes" + (#DataT "clojure.lang.Atom") + #Nil])])]))) (_lux_declare-tags [#writer #loader #classes]) ## (deftype (DefData' m) @@ -308,25 +305,25 @@ ## )) (_lux_def Module (#AllT [(#Some #Nil) "lux;Module" "Compiler" - (#RecordT (#Cons [## "lux;module-aliases" - (#AppT [List (#TupleT (#Cons [Text (#Cons [Text #Nil])]))]) - (#Cons [## "lux;defs" - (#AppT [List (#TupleT (#Cons [Text - (#Cons [(#TupleT (#Cons [Bool (#Cons [(#AppT [DefData' (#LambdaT [ASTList - (#AppT [(#AppT [StateE (#BoundT "Compiler")]) - ASTList])])]) - #Nil])])) - #Nil])]))]) - (#Cons [## "lux;imports" - (#AppT [List Text]) - (#Cons [## "lux;tags" - (#AppT [List - (#TupleT (#Cons Text - (#Cons (#TupleT (#Cons Int - (#Cons (#AppT [List Ident]) - #Nil))) - #Nil)))]) - #Nil])])])]))])) + (#TupleT (#Cons [## "lux;module-aliases" + (#AppT [List (#TupleT (#Cons [Text (#Cons [Text #Nil])]))]) + (#Cons [## "lux;defs" + (#AppT [List (#TupleT (#Cons [Text + (#Cons [(#TupleT (#Cons [Bool (#Cons [(#AppT [DefData' (#LambdaT [ASTList + (#AppT [(#AppT [StateE (#BoundT "Compiler")]) + ASTList])])]) + #Nil])])) + #Nil])]))]) + (#Cons [## "lux;imports" + (#AppT [List Text]) + (#Cons [## "lux;tags" + (#AppT [List + (#TupleT (#Cons Text + (#Cons (#TupleT (#Cons Int + (#Cons (#AppT [List Ident]) + #Nil))) + #Nil)))]) + #Nil])])])]))])) (_lux_export Module) (_lux_declare-tags [#module-aliases #defs #imports #tags]) @@ -343,28 +340,28 @@ ## )) (_lux_def Compiler (#AppT [(#AllT [(#Some #Nil) "lux;Compiler" "" - (#RecordT (#Cons [## "lux;source" - Source - (#Cons [## "lux;cursor" - Cursor - (#Cons [## "lux;modules" - (#AppT [List (#TupleT (#Cons [Text - (#Cons [(#AppT [Module (#AppT [(#BoundT "lux;Compiler") (#BoundT "")])]) - #Nil])]))]) - (#Cons [## "lux;envs" - (#AppT [List (#AppT [(#AppT [Env Text]) - (#TupleT (#Cons [LuxVar (#Cons [Type #Nil])]))])]) - (#Cons [## "lux;types" - (#AppT [(#AppT [Bindings Int]) Type]) - (#Cons [## "lux;expected" - Type - (#Cons [## "lux;seed" - Int - (#Cons [## "lux;eval?" - Bool - (#Cons [## "lux;host" - Host - #Nil])])])])])])])])]))]) + (#TupleT (#Cons [## "lux;source" + Source + (#Cons [## "lux;cursor" + Cursor + (#Cons [## "lux;modules" + (#AppT [List (#TupleT (#Cons [Text + (#Cons [(#AppT [Module (#AppT [(#BoundT "lux;Compiler") (#BoundT "")])]) + #Nil])]))]) + (#Cons [## "lux;envs" + (#AppT [List (#AppT [(#AppT [Env Text]) + (#TupleT (#Cons [LuxVar (#Cons [Type #Nil])]))])]) + (#Cons [## "lux;types" + (#AppT [(#AppT [Bindings Int]) Type]) + (#Cons [## "lux;expected" + Type + (#Cons [## "lux;seed" + Int + (#Cons [## "lux;eval?" + Bool + (#Cons [## "lux;host" + Host + #Nil])])])])])])])])]))]) Void])) (_lux_export Compiler) (_lux_declare-tags [#source #cursor #modules #envs #types #expected #seed #eval? #host]) @@ -1023,10 +1020,10 @@ (def''' Monad Type (All' [m] - (#RecordT (list (All' [a] (->' (B' a) ($' (B' m) (B' a)))) - (All' [a b] (->' (->' (B' a) ($' (B' m) (B' b))) - ($' (B' m) (B' a)) - ($' (B' m) (B' b)))))))) + (#TupleT (list (All' [a] (->' (B' a) ($' (B' m) (B' a)))) + (All' [a b] (->' (->' (B' a) ($' (B' m) (B' b))) + ($' (B' m) (B' a)) + ($' (B' m) (B' b)))))))) (_lux_declare-tags [#return #bind]) (def''' Maybe/Monad @@ -1626,7 +1623,7 @@ _ (fail "Wrong syntax for variant case.")))) (as-pairs pairs))] - (return [(`' (#RecordT (~ (untemplate-list (map second members))))) + (return [(`' (#TupleT (~ (untemplate-list (map second members))))) (#Some (|> members (map first) (map (: (-> Text AST) @@ -2106,39 +2103,21 @@ (#DataT name) ($ text:++ "(^ " name ")") - (#TupleT elems) - (case elems + (#TupleT members) + (case members #;Nil "(,)" _ - ($ text:++ "(, " (|> elems (map type:show) (interpose " ") (foldL text:++ "")) ")")) + ($ text:++ "(, " (|> members (map type:show) (interpose " ") (foldL text:++ "")) ")")) - (#VariantT cases) - (case cases + (#VariantT members) + (case members #;Nil "(|)" _ - ($ text:++ "(| " - (|> cases - (map type:show) - (interpose " ") - (foldL text:++ "")) - ")")) - - (#RecordT fields) - (case fields - #;Nil - "(&)" - - _ - ($ text:++ "(& " - (|> fields - (map type:show) - (interpose " ") - (foldL text:++ "")) - ")")) + ($ text:++ "(| " (|> members (map type:show) (interpose " ") (foldL text:++ "")) ")")) (#LambdaT input output) ($ text:++ "(-> " (type:show input) " " (type:show output) ")") @@ -2165,9 +2144,6 @@ (#VariantT ?cases) (#VariantT (map (beta-reduce env) ?cases)) - (#RecordT ?fields) - (#RecordT (map (beta-reduce env) ?fields)) - (#TupleT ?members) (#TupleT (map (beta-reduce env) ?members)) @@ -2219,7 +2195,7 @@ (def (resolve-struct-type type) (-> Type (Maybe Type)) (case type - (#RecordT slots) + (#TupleT slots) (#Some type) (#AppT fun arg) @@ -2727,7 +2703,7 @@ (let [[module name] (split-slot field-name) pattern (: AST (case (resolve-struct-type type) - (#Some (#RecordT slots)) + (#Some (#TupleT slots)) (record$ (map (: (-> (, Text Type) (, AST AST)) (lambda [[sname stype]] (use-field sname stype))) slots)) @@ -2744,7 +2720,7 @@ (do Lux/Monad [struct-type (find-var-type name)] (case (resolve-struct-type struct-type) - (#Some (#RecordT slots)) + (#Some (#TupleT slots)) (let [pattern (record$ (map (: (-> (, Text Type) (, AST AST)) (lambda [[sname stype]] (use-field sname stype))) slots))] @@ -2794,7 +2770,7 @@ g!blank (gensym "") g!output (gensym "")] (case (resolve-struct-type type) - (#Some (#RecordT slots)) + (#Some (#TupleT slots)) (do Lux/Monad [slot (normalize slot')] (let [[s-prefix s-name] (: Ident slot) @@ -2826,7 +2802,7 @@ (let [[module name] (split-slot field-name) source+ (: AST (` (get@ (~ (tag$ [module name])) (~ source))))] (case (resolve-struct-type type) - (#Some (#RecordT slots)) + (#Some (#TupleT slots)) (list:join (map (: (-> (, Text Type) (List AST)) (lambda [[sname stype]] (open-field prefix sname source+ stype))) slots)) @@ -2847,7 +2823,7 @@ struct-type (find-var-type struct-name) #let [source (symbol$ struct-name)]] (case (resolve-struct-type struct-type) - (#Some (#RecordT slots)) + (#Some (#TupleT slots)) (return (list:join (map (: (-> (, Text Type) (List AST)) (lambda [[sname stype]] (open-field prefix sname source stype))) slots))) @@ -2902,7 +2878,7 @@ (do Lux/Monad [type (find-var-type name)] (case (resolve-struct-type type) - (#Some (#RecordT slots)) + (#Some (#TupleT slots)) (do Lux/Monad [pattern' (map% Lux/Monad (: (-> (, Text Type) (Lux (, Text AST))) @@ -2950,7 +2926,7 @@ (do Lux/Monad [type (find-var-type name)] (case (resolve-struct-type type) - (#Some (#RecordT slots)) + (#Some (#TupleT slots)) (do Lux/Monad [pattern' (map% Lux/Monad (: (-> (, Text Type) (Lux (, Text AST))) @@ -3041,14 +3017,11 @@ (#DataT name) (` (#DataT (~ (text$ name)))) - (#TupleT parts) - (` (#TupleT (~ (untemplate-list (map type->syntax parts))))) - (#VariantT cases) (` (#VariantT (~ (untemplate-list (map type->syntax cases))))) - - (#RecordT fields) - (` (#RecordT (~ (untemplate-list (map type->syntax fields))))) + + (#TupleT parts) + (` (#TupleT (~ (untemplate-list (map type->syntax parts))))) (#LambdaT in out) (` (#LambdaT (~ (type->syntax in)) (~ (type->syntax out)))) 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