From 6676e1bb8e79ed4336b113b573f3b9f9dd8399af Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 17 Apr 2015 17:54:35 -0400 Subject: - Solved the bug wherein type-inferencing was causing computational complexity to explode and cause the compiler to become very slow (solved it by removing type-inference from tuples). - Also removed type-inference from functions/lambdas. - Added a small optimization to improve the efficiency of type-checking by not doing a thorough type-check when a global or local binding has a type variant with the same cases as Type, and it's exo-type is also like this (hopefully, it will never happen that someone will exploit this to make the compiler do something weird...) --- source/lux.lux | 396 +++++++++++++++++++++++++++------------------------------ 1 file changed, 188 insertions(+), 208 deletions(-) (limited to 'source/lux.lux') diff --git a/source/lux.lux b/source/lux.lux index 84eaab689..a08c88db7 100644 --- a/source/lux.lux +++ b/source/lux.lux @@ -74,215 +74,195 @@ #Nil])])])])])])])])])])]))]) #NothingT])))) -## (def' Type -## (case' (#AppT [(#BoundT "Type") (#BoundT "")]) -## Type -## (case' (#AppT [List (#TupleT (#Cons [Text (#Cons [Type #Nil])]))]) -## TypeEnv -## (#AppT [(#AllT [#Nil "Type" "" -## (#VariantT (#Cons [["lux;AnyT" (#TupleT #Nil)] -## (#Cons [["lux;NothingT" (#TupleT #Nil)] -## (#Cons [["lux;DataT" Text] -## (#Cons [["lux;TupleT" (#AppT [List (#AppT [(#BoundT "Type") (#BoundT "")])])] -## (#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 [TypeEnv (#Cons [Text (#Cons [Text (#Cons [Type #Nil])])])]))] -## (#Cons [["lux;AppT" (#TupleT (#Cons [Type (#Cons [Type #Nil])]))] -## #Nil])])])])])])])])])])]))]) -## #NothingT])))) - -## ## (deftype (Maybe a) -## ## (| #None -## ## (#Some a))) -## (def' Maybe -## (#AllT [#Nil "Maybe" "a" -## (#VariantT (#Cons [["lux;None" (#TupleT #Nil)] -## (#Cons [["lux;Some" (#BoundT "a")] -## #Nil])]))])) - -## ## (deftype (Bindings k v) -## ## (& #counter Int -## ## #mappings (List (, k v)))) -## (def' Bindings -## (#AllT [#Nil "Bindings" "k" -## (#AllT [#Nil "" "v" -## (#RecordT (#Cons [["lux;counter" Int] -## (#Cons [["lux;mappings" (#AppT [List -## (#TupleT (#Cons [(#BoundT "k") -## (#Cons [(#BoundT "v") -## #Nil])]))])] -## #Nil])]))])])) - -## ## (deftype (Env k v) -## ## (& #name Text -## ## #inner-closures Int -## ## #locals (Bindings k v) -## ## #closure (Bindings k v))) -## (def' Env -## (#AllT [#Nil "Env" "k" -## (#AllT [#Nil "" "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])])])]))])])) - -## ## (deftype Cursor -## ## (, Text Int Int)) -## (def' Cursor -## (#TupleT (#Cons [Text (#Cons [Int (#Cons [Int #Nil])])]))) - -## ## (deftype (Meta m v) -## ## (| (#Meta (, m v)))) -## (def' Meta -## (#AllT [#Nil "Meta" "m" -## (#AllT [#Nil "" "v" -## (#VariantT (#Cons [["lux;Meta" (#TupleT (#Cons [(#BoundT "m") -## (#Cons [(#BoundT "v") -## #Nil])]))] -## #Nil]))])])) - -## ## (def' Reader -## ## (List (Meta Cursor Text))) -## (def' Reader -## (#AppT [List -## (#AppT [(#AppT [Meta Cursor]) -## Text])])) - -## ## (deftype Compiler_State -## ## (& #source (Maybe Reader) -## ## #modules (List Any) -## ## #module-aliases (List Any) -## ## #global-env (Maybe (Env Text Any)) -## ## #local-envs (List (Env Text Any)) -## ## #types (Bindings Int Type) -## ## #writer (^ org.objectweb.asm.ClassWriter) -## ## #loader (^ java.net.URLClassLoader) -## ## #eval-ctor Int)) -## (def' Compiler_State -## (#RecordT (#Cons [["lux;source" (#AppT [Maybe Reader])] -## (#Cons [["lux;modules" (#AppT [List Any])] -## (#Cons [["lux;module-aliases" (#AppT [List Any])] -## (#Cons [["lux;global-env" (#AppT [Maybe (#AppT [(#AppT [Env Text]) Any])])] -## (#Cons [["lux;local-envs" (#AppT [List (#AppT [(#AppT [Env Text]) Any])])] -## (#Cons [["lux;types" (#AppT [(#AppT [Bindings Int]) Type])] -## (#Cons [["lux;writer" (#DataT "org.objectweb.asm.ClassWriter")] -## (#Cons [["lux;loader" (#DataT "java.lang.ClassLoader")] -## (#Cons [["lux;eval-ctor" Int] -## #Nil])])])])])])])])]))) - -## ## (deftype #rec Syntax -## ## (Meta Cursor (| (#Bool Bool) -## ## (#Int Int) -## ## (#Real Real) -## ## (#Char Char) -## ## (#Text Text) -## ## (#Form (List Syntax)) -## ## (#Tuple (List Syntax)) -## ## (#Record (List (, Text Syntax)))))) -## (def' Syntax -## (case' (#AppT [(#BoundT "Syntax") (#BoundT "")]) -## Syntax -## (case' (#AppT [List Syntax]) -## SyntaxList -## (#AppT [(#AllT [#Nil "Syntax" "" -## (#AppT [(#AppT [Meta Cursor]) -## (#VariantT (#Cons [["lux;Bool" Bool] -## (#Cons [["lux;Int" Int] -## (#Cons [["lux;Real" Real] -## (#Cons [["lux;Char" Char] -## (#Cons [["lux;Text" Text] -## (#Cons [["lux;Form" SyntaxList] -## (#Cons [["lux;Tuple" SyntaxList] -## (#Cons [["lux;Record" (#AppT [List (#TupleT (#Cons [Text (#Cons [Syntax #Nil])]))])] -## #Nil])])])])])])])]))])]) -## #NothingT])))) +## (deftype (Maybe a) +## (| #None +## (#Some a))) +(def' Maybe + (check' Type + (#AllT [#Nil "Maybe" "a" + (#VariantT (#Cons [["lux;None" (#TupleT #Nil)] + (#Cons [["lux;Some" (#BoundT "a")] + #Nil])]))]))) + +## (deftype (Bindings k v) +## (& #counter Int +## #mappings (List (, k v)))) +(def' Bindings + (check' Type + (#AllT [#Nil "Bindings" "k" + (#AllT [#Nil "" "v" + (#RecordT (#Cons [["lux;counter" Int] + (#Cons [["lux;mappings" (#AppT [List + (#TupleT (#Cons [(#BoundT "k") + (#Cons [(#BoundT "v") + #Nil])]))])] + #Nil])]))])]))) + +## (deftype (Env k v) +## (& #name Text +## #inner-closures Int +## #locals (Bindings k v) +## #closure (Bindings k v))) +(def' Env + (check' Type + (#AllT [#Nil "Env" "k" + (#AllT [#Nil "" "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])])])]))])]))) + +## (deftype Cursor +## (, Text Int Int)) +(def' Cursor + (check' Type + (#TupleT (#Cons [Text (#Cons [Int (#Cons [Int #Nil])])])))) + +## (deftype (Meta m v) +## (| (#Meta (, m v)))) +(def' Meta + (check' Type + (#AllT [#Nil "Meta" "m" + (#AllT [#Nil "" "v" + (#VariantT (#Cons [["lux;Meta" (#TupleT (#Cons [(#BoundT "m") + (#Cons [(#BoundT "v") + #Nil])]))] + #Nil]))])]))) -## ## ## (deftype (Either l r) -## ## ## (| (#Left l) -## ## ## (#Right r))) -## ## (def' Either -## ## (#AllT [#Nil "_" "l" -## ## (#AllT [#Nil "" "r" -## ## (#VariantT (#Cons [["lux;Left" (#BoundT "l")] -## ## (#Cons [["lux;Right" (#BoundT "r")] -## ## #Nil])]))])])) - -## ## ## (deftype Macro -## ## ## (-> (List Syntax) Compiler_State -## ## ## (Either Text [Compiler_State (List Syntax)]))) -## ## (def' Macro -## ## (case' (#AppT [List Syntax]) -## ## SyntaxList -## ## (#LambdaT [SyntaxList -## ## (#LambdaT [Compiler_State -## ## (#AppT [(#AppT [Either Text]) -## ## (#TupleT (#Cons [Compiler_State -## ## (#Cons [SyntaxList #Nil])]))])])]))) - -## ## ## Base functions & macros -## ## ## (def (_meta data) -## ## ## (All [a] (-> a (Meta Cursor a))) -## ## ## (#Meta [["" -1 -1] data])) -## ## (def' _meta -## ## (check' (#AllT [#Nil "_" "a" -## ## (#LambdaT [(#BoundT "a") -## ## (#AppT [(#AppT [Meta Cursor]) -## ## (#BoundT "a")])])]) -## ## (lambda' _ data -## ## (#Meta [["" -1 -1] data])))) - -## ## (def' let' -## ## (check' Macro -## ## (lambda' _ tokens -## ## (lambda' _ state -## ## (case' tokens -## ## (#Cons [lhs (#Cons [rhs (#Cons [body #Nil])])]) -## ## (#Right [state -## ## (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "case'"])) -## ## (#Cons [rhs (#Cons [lhs (#Cons [body #Nil])])])]))) -## ## #Nil])]) - -## ## _ -## ## (#Left "Wrong syntax for let'")) -## ## )))) - -## ## (def' let' -## ## (check' Macro -## ## (lambda' _ tokens -## ## (lambda' _ state -## ## (#Left "Wrong syntax for let'") -## ## )))) - -## ## (def' let' -## ## (lambda' _ tokens -## ## (lambda' _ state -## ## (case' tokens -## ## (#Cons [lhs (#Cons [rhs (#Cons [body #Nil])])]) -## ## (#Right [state -## ## (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "case'"])) -## ## (#Cons [rhs (#Cons [lhs (#Cons [body #Nil])])])]))) -## ## #Nil])]) - -## ## _ -## ## (#Left "Wrong syntax for let'")) -## ## ))) -## ## (declare-macro' let') - -## ## ## ## (All 21268 -## ## ## ## (-> 21268 -## ## ## ## (All 21267 -## ## ## ## (-> 21267 -## ## ## ## (| (#lux;Right (, 21267 -## ## ## ## (| (#lux;Cons (, (((All Meta m (All v (| (#lux;Meta (, m v))))) -## ## ## ## (, (^ java.lang.String []) (^ java.lang.Long []) (^ java.lang.Long []))) -## ## ## ## ⌈17⌋) -## ## ## ## (| (#lux;Nil (, ))))))))))))) +## (def' Reader +## (List (Meta Cursor Text))) +(def' Reader + (check' Type + (#AppT [List + (#AppT [(#AppT [Meta Cursor]) + Text])]))) + +## (deftype CompilerState +## (& #source (Maybe Reader) +## #modules (List Any) +## #module-aliases (List Any) +## #global-env (Maybe (Env Text Any)) +## #local-envs (List (Env Text Any)) +## #types (Bindings Int Type) +## #writer (^ org.objectweb.asm.ClassWriter) +## #loader (^ java.net.URLClassLoader) +## #eval-ctor Int)) +(def' CompilerState + (check' Type + (#RecordT (#Cons [["lux;source" (#AppT [Maybe Reader])] + (#Cons [["lux;modules" (#AppT [List Any])] + (#Cons [["lux;module-aliases" (#AppT [List Any])] + (#Cons [["lux;global-env" (#AppT [Maybe (#AppT [(#AppT [Env Text]) Any])])] + (#Cons [["lux;local-envs" (#AppT [List (#AppT [(#AppT [Env Text]) Any])])] + (#Cons [["lux;types" (#AppT [(#AppT [Bindings Int]) Type])] + (#Cons [["lux;writer" (#DataT "org.objectweb.asm.ClassWriter")] + (#Cons [["lux;loader" (#DataT "java.lang.ClassLoader")] + (#Cons [["lux;eval-ctor" Int] + #Nil])])])])])])])])])))) + +## (deftype #rec Syntax +## (Meta Cursor (| (#Bool Bool) +## (#Int Int) +## (#Real Real) +## (#Char Char) +## (#Text Text) +## (#Form (List Syntax)) +## (#Tuple (List Syntax)) +## (#Record (List (, Text Syntax)))))) +(def' Syntax + (check' Type + (case' (#AppT [(#BoundT "Syntax") (#BoundT "")]) + Syntax + (case' (#AppT [List Syntax]) + SyntaxList + (#AppT [(#AllT [#Nil "Syntax" "" + (#AppT [(#AppT [Meta Cursor]) + (#VariantT (#Cons [["lux;Bool" Bool] + (#Cons [["lux;Int" Int] + (#Cons [["lux;Real" Real] + (#Cons [["lux;Char" Char] + (#Cons [["lux;Text" Text] + (#Cons [["lux;Form" SyntaxList] + (#Cons [["lux;Tuple" SyntaxList] + (#Cons [["lux;Record" (#AppT [List (#TupleT (#Cons [Text (#Cons [Syntax #Nil])]))])] + #Nil])])])])])])])]))])]) + #NothingT]))))) + +## (deftype (Either l r) +## (| (#Left l) +## (#Right r))) +(def' Either + (check' Type + (#AllT [#Nil "_" "l" + (#AllT [#Nil "" "r" + (#VariantT (#Cons [["lux;Left" (#BoundT "l")] + (#Cons [["lux;Right" (#BoundT "r")] + #Nil])]))])]))) + +## (deftype Macro +## (-> (List Syntax) CompilerState +## (Either Text [CompilerState (List Syntax)]))) +(def' Macro + (check' Type + (case' (#AppT [List Syntax]) + SyntaxList + (#LambdaT [SyntaxList + (#LambdaT [CompilerState + (#AppT [(#AppT [Either Text]) + (#TupleT (#Cons [CompilerState + (#Cons [SyntaxList #Nil])]))])])])))) + +## Base functions & macros +## (def (_meta data) +## (All [a] (-> a (Meta Cursor a))) +## (#Meta [["" -1 -1] data])) +(def' _meta + (check' (#AllT [#Nil "_" "a" + (#LambdaT [(#BoundT "a") + (#AppT [(#AppT [Meta Cursor]) + (#BoundT "a")])])]) + (lambda' _ data + (#Meta [["" -1 -1] data])))) + +## (def' let' +## (check' Macro +## (lambda' _ tokens +## (lambda' _ state +## (case' tokens +## (#Cons [lhs (#Cons [rhs (#Cons [body #Nil])])]) +## (#Right [state +## (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "case'"])) +## (#Cons [rhs (#Cons [lhs (#Cons [body #Nil])])])]))) +## #Nil])]) + +## _ +## (#Left "Wrong syntax for let'")) +## )))) + +## (def' let' +## (check' Macro +## (lambda' _ tokens +## (lambda' _ state +## (#Left "Wrong syntax for let'") +## )))) + +## (def' let' +## (lambda' _ tokens +## (lambda' _ state +## (case' tokens +## (#Cons [lhs (#Cons [rhs (#Cons [body #Nil])])]) +## (#Right [state +## (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "case'"])) +## (#Cons [rhs (#Cons [lhs (#Cons [body #Nil])])])]))) +## #Nil])]) + +## _ +## (#Left "Wrong syntax for let'")) +## ))) +## (declare-macro' let') ## ## ## (def' lambda ## ## ## (check' Macro -- cgit v1.2.3