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 ++++++++++++++++++++++++++------------------------------- 1 file changed, 152 insertions(+), 179 deletions(-) (limited to 'source/lux.lux') 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)))) -- cgit v1.2.3