From 4134c811399abfce64b54a821e427d2b153f3e57 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 10 Aug 2015 18:25:39 -0400 Subject: - Changing tags so they're actually indices (part 1). - Fixed a bug regarding type coercion (type-checking was ocurring unnecessarily). - Fixed another bug regarding Local/Global variables. --- source/lux.lux | 308 +++++++++++++++++++++++++++++++++++---------------------- 1 file changed, 190 insertions(+), 118 deletions(-) (limited to 'source/lux.lux') diff --git a/source/lux.lux b/source/lux.lux index 7110cc709..d023406f8 100644 --- a/source/lux.lux +++ b/source/lux.lux @@ -10,6 +10,10 @@ (_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 [#None #Some]) +(_lux_declare-tags [#Nil #Cons]) + ## Basic types (_lux_def Bool (#DataT "java.lang.Boolean")) (_lux_export Bool) @@ -40,11 +44,13 @@ ## (#Cons a (List a)))) (_lux_def List (#AllT (#Some #Nil) "lux;List" "a" - (#VariantT (#Cons ["lux;Nil" (#TupleT #Nil)] - (#Cons ["lux;Cons" (#TupleT (#Cons (#BoundT "a") - (#Cons (#AppT (#BoundT "lux;List") (#BoundT "a")) - #Nil)))] - #Nil))))) + (#VariantT (#Cons ## "lux;Nil" + (#TupleT #Nil) + (#Cons ## "lux;Cons" + (#TupleT (#Cons (#BoundT "a") + (#Cons (#AppT (#BoundT "lux;List") (#BoundT "a")) + #Nil))) + #Nil))))) (_lux_export List) ## (deftype (Maybe a) @@ -52,16 +58,18 @@ ## (#Some a))) (_lux_def Maybe (#AllT (#Some #Nil) "lux;Maybe" "a" - (#VariantT (#Cons ["lux;None" (#TupleT #Nil)] - (#Cons ["lux;Some" (#BoundT "a")] - #Nil))))) + (#VariantT (#Cons ## "lux;None" + (#TupleT #Nil) + (#Cons ## "lux;Some" + (#BoundT "a") + #Nil))))) (_lux_export Maybe) ## (deftype #rec Type ## (| (#DataT Text) ## (#TupleT (List Type)) -## (#VariantT (List (, Text Type))) -## (#RecordT (List (, Text Type))) +## (#VariantT (List Type)) +## (#RecordT (List Type)) ## (#LambdaT Type Type) ## (#BoundT Text) ## (#VarT Int) @@ -72,19 +80,31 @@ Type (_lux_case (#AppT List (#TupleT (#Cons Text (#Cons Type #Nil)))) TypeEnv - (#AppT (#AllT (#Some #Nil) "Type" "_" - (#VariantT (#Cons ["lux;DataT" Text] - (#Cons ["lux;TupleT" (#AppT List Type)] - (#Cons ["lux;VariantT" TypeEnv] - (#Cons ["lux;RecordT" TypeEnv] - (#Cons ["lux;LambdaT" (#TupleT (#Cons Type (#Cons Type #Nil)))] - (#Cons ["lux;BoundT" Text] - (#Cons ["lux;VarT" 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)))] - (#Cons ["lux;ExT" Int] - #Nil)))))))))))) - Void)))) + (_lux_case (#AppT List Type) + TypeList + (#AppT (#AllT (#Some #Nil) "Type" "_" + (#VariantT (#Cons ## "lux;DataT" + Text + (#Cons ## "lux;TupleT" + TypeList + (#Cons ## "lux;VariantT" + TypeList + (#Cons ## "lux;RecordT" + TypeList + (#Cons ## "lux;LambdaT" + (#TupleT (#Cons Type (#Cons Type #Nil))) + (#Cons ## "lux;BoundT" + Text + (#Cons ## "lux;VarT" + 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)))))))))))) + Void))))) (_lux_export Type) ## (deftype (Bindings k v) @@ -93,12 +113,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])]))])])) + (#RecordT (#Cons ## "lux;counter" + Int + (#Cons ## "lux;mappings" + (#AppT [List + (#TupleT (#Cons [(#BoundT "k") + (#Cons [(#BoundT "v") + #Nil])]))]) + #Nil)))])])) (_lux_export Bindings) ## (deftype (Env k v) @@ -109,12 +131,16 @@ (_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")])] + (#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])])])]))])])) (_lux_export Env) @@ -129,11 +155,13 @@ (_lux_def Meta (#AllT [(#Some #Nil) "lux;Meta" "m" (#AllT [#None "" "v" - (#VariantT (#Cons [["lux;Meta" (#TupleT (#Cons [(#BoundT "m") - (#Cons [(#BoundT "v") - #Nil])]))] + (#VariantT (#Cons [## "lux;Meta" + (#TupleT (#Cons [(#BoundT "m") + (#Cons [(#BoundT "v") + #Nil])])) #Nil]))])])) (_lux_export Meta) +(_lux_declare-tags [#Meta]) ## (deftype (AST' w) ## (| (#BoolS Bool) @@ -154,20 +182,31 @@ (_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])]))])] + (#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)))) @@ -185,10 +224,13 @@ (_lux_def Either (#AllT [(#Some #Nil) "lux;Either" "l" (#AllT [#None "" "r" - (#VariantT (#Cons [["lux;Left" (#BoundT "l")] - (#Cons [["lux;Right" (#BoundT "r")] + (#VariantT (#Cons [## "lux;Left" + (#BoundT "l") + (#Cons [## "lux;Right" + (#BoundT "r") #Nil])]))])])) (_lux_export Either) +(_lux_declare-tags [#Left #Right]) ## (deftype (StateE s a) ## (-> s (Either Text (, s a)))) @@ -214,9 +256,12 @@ ## #loader (^ java.net.URLClassLoader) ## #classes (^ clojure.lang.Atom))) (_lux_def HostState - (#RecordT (#Cons [["lux;writer" (#DataT "org.objectweb.asm.ClassWriter")] - (#Cons [["lux;loader" (#DataT "java.lang.ClassLoader")] - (#Cons [["lux;classes" (#DataT "clojure.lang.Atom")] + (#RecordT (#Cons [## "lux;writer" + (#DataT "org.objectweb.asm.ClassWriter") + (#Cons [## "lux;loader" + (#DataT "java.lang.ClassLoader") + (#Cons [## "lux;classes" + (#DataT "clojure.lang.Atom") #Nil])])]))) ## (deftype (DefData' m) @@ -226,12 +271,16 @@ ## (#AliasD Ident))) (_lux_def DefData' (#AllT [(#Some #Nil) "lux;DefData'" "" - (#VariantT (#Cons [["lux;TypeD" Type] - (#Cons [["lux;ValueD" (#TupleT (#Cons [Type - (#Cons [Unit - #Nil])]))] - (#Cons [["lux;MacroD" (#BoundT "")] - (#Cons [["lux;AliasD" Ident] + (#VariantT (#Cons [## "lux;TypeD" + Type + (#Cons [## "lux;ValueD" + (#TupleT (#Cons [Type + (#Cons [Unit + #Nil])])) + (#Cons [## "lux;MacroD" + (#BoundT "") + (#Cons [## "lux;AliasD" + Ident #Nil])])])]))])) (_lux_export DefData') @@ -239,27 +288,40 @@ ## (| (#Local Int) ## (#Global Ident))) (_lux_def LuxVar - (#VariantT (#Cons [["lux;Local" Int] - (#Cons [["lux;Global" Ident] + (#VariantT (#Cons [## "lux;Local" + Int + (#Cons [## "lux;Global" + Ident #Nil])]))) (_lux_export LuxVar) ## (deftype (Module Compiler) ## (& #module-aliases (List (, Text Text)) -## #defs (List (, Text (, Bool (DefData' (-> (List AST) (StateE Compiler (List AST))))))) -## #imports (List Text) +## #defs (List (, Text (, Bool (DefData' (-> (List AST) (StateE Compiler (List AST))))))) +## #imports (List Text) +## #tags (List (, Text (, Int (List Ident)))) ## )) (_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])] - #Nil])])]))])) + (#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])])])]))])) (_lux_export Module) ## (deftype #rec Compiler @@ -271,21 +333,31 @@ ## #seed Int ## #eval? Bool ## #expected Type -## #cursor Cursor)) +## #cursor Cursor +## )) (_lux_def Compiler (#AppT [(#AllT [(#Some #Nil) "lux;Compiler" "" - (#RecordT (#Cons [["lux;source" Reader] - (#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;host" HostState] - (#Cons [["lux;seed" Int] - (#Cons [["lux;eval?" Bool] - (#Cons [["lux;expected" Type] - (#Cons [["lux;cursor" Cursor] + (#RecordT (#Cons [## "lux;source" + Reader + (#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;host" + HostState + (#Cons [## "lux;seed" + Int + (#Cons [## "lux;eval?" + Bool + (#Cons [## "lux;expected" + Type + (#Cons [## "lux;cursor" + Cursor #Nil])])])])])])])])]))]) Void])) (_lux_export Compiler) @@ -293,9 +365,9 @@ ## (deftype Macro ## (-> (List AST) (StateE Compiler (List AST)))) (_lux_def Macro - (#LambdaT [ASTList - (#AppT [(#AppT [StateE Compiler]) - ASTList])])) + (#LambdaT ASTList + (#AppT (#AppT StateE Compiler) + ASTList))) (_lux_export Macro) ## Base functions & macros @@ -309,11 +381,11 @@ ## (-> (AST' (Meta Cursor)) AST) ## (#Meta [["" -1 -1] data])) (_lux_def _meta - (_lux_: (#LambdaT [(#AppT [AST' - (#AppT [Meta Cursor])]) - AST]) + (_lux_: (#LambdaT (#AppT AST' + (#AppT Meta Cursor)) + AST) (_lux_lambda _ data - (#Meta [_cursor data])))) + (#Meta _cursor data)))) ## (def (return x) ## (All [a] @@ -321,16 +393,16 @@ ## (Either Text (, Compiler a)))) ## ...) (_lux_def return - (_lux_: (#AllT [(#Some #Nil) "" "a" - (#LambdaT [(#BoundT "a") - (#LambdaT [Compiler - (#AppT [(#AppT [Either Text]) - (#TupleT (#Cons [Compiler - (#Cons [(#BoundT "a") - #Nil])]))])])])]) + (_lux_: (#AllT (#Some #Nil) "" "a" + (#LambdaT (#BoundT "a") + (#LambdaT Compiler + (#AppT (#AppT Either Text) + (#TupleT (#Cons Compiler + (#Cons (#BoundT "a") + #Nil))))))) (_lux_lambda _ val (_lux_lambda _ state - (#Right [state val]))))) + (#Right state val))))) ## (def (fail msg) ## (All [a] @@ -338,49 +410,49 @@ ## (Either Text (, Compiler a)))) ## ...) (_lux_def fail - (_lux_: (#AllT [(#Some #Nil) "" "a" - (#LambdaT [Text - (#LambdaT [Compiler - (#AppT [(#AppT [Either Text]) - (#TupleT (#Cons [Compiler - (#Cons [(#BoundT "a") - #Nil])]))])])])]) + (_lux_: (#AllT (#Some #Nil) "" "a" + (#LambdaT Text + (#LambdaT Compiler + (#AppT (#AppT Either Text) + (#TupleT (#Cons Compiler + (#Cons (#BoundT "a") + #Nil))))))) (_lux_lambda _ msg (_lux_lambda _ state (#Left msg))))) (_lux_def text$ - (_lux_: (#LambdaT [Text AST]) + (_lux_: (#LambdaT Text AST) (_lux_lambda _ text (_meta (#TextS text))))) (_lux_def int$ - (_lux_: (#LambdaT [Int AST]) + (_lux_: (#LambdaT Int AST) (_lux_lambda _ value (_meta (#IntS value))))) (_lux_def symbol$ - (_lux_: (#LambdaT [Ident AST]) + (_lux_: (#LambdaT Ident AST) (_lux_lambda _ ident (_meta (#SymbolS ident))))) (_lux_def tag$ - (_lux_: (#LambdaT [Ident AST]) + (_lux_: (#LambdaT Ident AST) (_lux_lambda _ ident (_meta (#TagS ident))))) (_lux_def form$ - (_lux_: (#LambdaT [(#AppT [List AST]) AST]) + (_lux_: (#LambdaT (#AppT List AST) AST) (_lux_lambda _ tokens (_meta (#FormS tokens))))) (_lux_def tuple$ - (_lux_: (#LambdaT [(#AppT [List AST]) AST]) + (_lux_: (#LambdaT (#AppT List AST) AST) (_lux_lambda _ tokens (_meta (#TupleS tokens))))) (_lux_def record$ - (_lux_: (#LambdaT [(#AppT [List (#TupleT (#Cons [AST (#Cons [AST #Nil])]))]) AST]) + (_lux_: (#LambdaT (#AppT List (#TupleT (#Cons AST (#Cons AST #Nil)))) AST) (_lux_lambda _ tokens (_meta (#RecordS tokens))))) @@ -388,10 +460,10 @@ (_lux_: Macro (_lux_lambda _ tokens (_lux_case tokens - (#Cons [lhs (#Cons [rhs (#Cons [body #Nil])])]) - (return (#Cons [(form$ (#Cons [(symbol$ ["" "_lux_case"]) - (#Cons [rhs (#Cons [lhs (#Cons [body #Nil])])])])) - #Nil])) + (#Cons lhs (#Cons rhs (#Cons body #Nil))) + (return (#Cons (form$ (#Cons (symbol$ ["" "_lux_case"]) + (#Cons rhs (#Cons lhs (#Cons body #Nil))))) + #Nil)) _ (fail "Wrong syntax for let''"))))) -- cgit v1.2.3