aboutsummaryrefslogtreecommitdiff
path: root/source/lux.lux
diff options
context:
space:
mode:
authorEduardo Julian2015-08-16 13:28:07 -0400
committerEduardo Julian2015-08-16 13:28:07 -0400
commit3d18954a2307b48c955f5bdd3790a92ffeb7284c (patch)
tree52d995889b1b53921405681098f81f9dc471fa73 /source/lux.lux
parent9ccdc7b5b59c2f0ffea49fc32d7b37eb2308bb9c (diff)
Unified tuples & records.
Diffstat (limited to 'source/lux.lux')
-rw-r--r--source/lux.lux331
1 files changed, 152 insertions, 179 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))))