From 1f0be2351bc76b0de15d97691f8ea0728d9ab321 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Fri, 22 May 2015 23:06:19 -0400
Subject: - Added a simple optimization based on the idea of avoiding to
compare 2 type-functions which are most-likely the same, due to their name
(remembering that when you define types using deftype, the type-function's
name will correspond to the def's). - Gave empty environments to top-level
type-functions, instead of leaving them with unset environments.
---
source/lux.lux | 70 ++++++++++++++++++++++++++++----------------------------
src/lux/type.clj | 68 ++++++++++++++++++++++++++++--------------------------
2 files changed, 70 insertions(+), 68 deletions(-)
diff --git a/source/lux.lux b/source/lux.lux
index e3f3ba243..9b5601eb4 100644
--- a/source/lux.lux
+++ b/source/lux.lux
@@ -37,10 +37,10 @@
## (| #Nil
## (#Cons (, a (List a)))))
(_lux_def List
- (#AllT [#None "List" "a"
+ (#AllT [(#Some #Nil) "lux;List" "a"
(#VariantT (#Cons [["lux;Nil" (#TupleT #Nil)]
(#Cons [["lux;Cons" (#TupleT (#Cons [(#BoundT "a")
- (#Cons [(#AppT [(#BoundT "List") (#BoundT "a")])
+ (#Cons [(#AppT [(#BoundT "lux;List") (#BoundT "a")])
#Nil])]))]
#Nil])]))]))
(_lux_export List)
@@ -49,7 +49,7 @@
## (| #None
## (#Some a)))
(_lux_def Maybe
- (#AllT [#None "Maybe" "a"
+ (#AllT [(#Some #Nil) "lux;Maybe" "a"
(#VariantT (#Cons [["lux;None" (#TupleT #Nil)]
(#Cons [["lux;Some" (#BoundT "a")]
#Nil])]))]))
@@ -70,7 +70,7 @@
Type
(_lux_case (#AppT [List (#TupleT (#Cons [Text (#Cons [Type #Nil])]))])
TypeEnv
- (#AppT [(#AllT [#None "Type" "_"
+ (#AppT [(#AllT [(#Some #Nil) "Type" "_"
(#VariantT (#Cons [["lux;DataT" Text]
(#Cons [["lux;TupleT" (#AppT [List Type])]
(#Cons [["lux;VariantT" TypeEnv]
@@ -89,7 +89,7 @@
## (& #counter Int
## #mappings (List (, k v))))
(_lux_def Bindings
- (#AllT [#None "Bindings" "k"
+ (#AllT [(#Some #Nil) "lux;Bindings" "k"
(#AllT [#None "" "v"
(#RecordT (#Cons [["lux;counter" Int]
(#Cons [["lux;mappings" (#AppT [List
@@ -104,7 +104,7 @@
## #locals (Bindings k v)
## #closure (Bindings k v)))
(_lux_def Env
- (#AllT [#None "Env" "k"
+ (#AllT [(#Some #Nil) "lux;Env" "k"
(#AllT [#None "" "v"
(#RecordT (#Cons [["lux;name" Text]
(#Cons [["lux;inner-closures" Int]
@@ -122,7 +122,7 @@
## (deftype (Meta m v)
## (| (#Meta (, m v))))
(_lux_def Meta
- (#AllT [#None "Meta" "m"
+ (#AllT [(#Some #Nil) "lux;Meta" "m"
(#AllT [#None "" "v"
(#VariantT (#Cons [["lux;Meta" (#TupleT (#Cons [(#BoundT "m")
(#Cons [(#BoundT "v")
@@ -143,12 +143,12 @@
## (#RecordS (List (, (w (Syntax' w)) (w (Syntax' w)))))))
(_lux_def Syntax'
(_lux_case (#AppT [(#BoundT "w")
- (#AppT [(#BoundT "Syntax'")
+ (#AppT [(#BoundT "lux;Syntax'")
(#BoundT "w")])])
Syntax
(_lux_case (#AppT [List Syntax])
SyntaxList
- (#AllT [#None "Syntax'" "w"
+ (#AllT [(#Some #Nil) "lux;Syntax'" "w"
(#VariantT (#Cons [["lux;BoolS" Bool]
(#Cons [["lux;IntS" Int]
(#Cons [["lux;RealS" Real]
@@ -178,7 +178,7 @@
## (| (#Left l)
## (#Right r)))
(_lux_def Either
- (#AllT [#None "_" "l"
+ (#AllT [(#Some #Nil) "lux;Either" "l"
(#AllT [#None "" "r"
(#VariantT (#Cons [["lux;Left" (#BoundT "l")]
(#Cons [["lux;Right" (#BoundT "r")]
@@ -188,7 +188,7 @@
## (deftype (StateE s a)
## (-> s (Either Text (, s a))))
(_lux_def StateE
- (#AllT [#None "StateE" "s"
+ (#AllT [(#Some #Nil) "lux;StateE" "s"
(#AllT [#None "" "a"
(#LambdaT [(#BoundT "s")
(#AppT [(#AppT [Either Text])
@@ -218,7 +218,7 @@
## (#MacroD m)
## (#AliasD Ident)))
(_lux_def DefData'
- (#AllT [#None "DefData'" ""
+ (#AllT [(#Some #Nil) "lux;DefData'" ""
(#VariantT (#Cons [["lux;TypeD" (#TupleT #Nil)]
(#Cons [["lux;ValueD" Type]
(#Cons [["lux;MacroD" (#BoundT "")]
@@ -234,20 +234,20 @@
#Nil])])))
(_lux_export LuxVar)
-## (deftype #rec CompilerState
+## (deftype #rec Compiler
## (& #source Reader
-## #modules (List (, Text (List (, Text (, Bool (DefData' (-> (List Syntax) (StateE CompilerState (List Syntax)))))))))
+## #modules (List (, Text (List (, Text (, Bool (DefData' (-> (List Syntax) (StateE Compiler (List Syntax)))))))))
## #module-aliases (List Void)
## #envs (List (Env Text (, LuxVar Type)))
## #types (Bindings Int Type)
## #host HostState))
-(_lux_def CompilerState
- (#AppT [(#AllT [#None "CompilerState" ""
+(_lux_def Compiler
+ (#AppT [(#AllT [(#Some #Nil) "lux;Compiler" ""
(#RecordT (#Cons [["lux;source" Reader]
(#Cons [["lux;modules" (#AppT [List (#TupleT (#Cons [Text
(#Cons [(#AppT [List (#TupleT (#Cons [Text
(#Cons [(#TupleT (#Cons [Bool (#Cons [(#AppT [DefData' (#LambdaT [SyntaxList
- (#AppT [(#AppT [StateE (#AppT [(#BoundT "CompilerState")
+ (#AppT [(#AppT [StateE (#AppT [(#BoundT "lux;Compiler")
(#BoundT "")])])
SyntaxList])])])
#Nil])]))
@@ -261,13 +261,13 @@
(#Cons [["lux;seed" Int]
#Nil])])])])])])]))])
Void]))
-(_lux_export CompilerState)
+(_lux_export Compiler)
## (deftype Macro
-## (-> (List Syntax) (StateE CompilerState (List Syntax))))
+## (-> (List Syntax) (StateE Compiler (List Syntax))))
(_lux_def Macro
(#LambdaT [SyntaxList
- (#AppT [(#AppT [StateE CompilerState])
+ (#AppT [(#AppT [StateE Compiler])
SyntaxList])]))
(_lux_export Macro)
@@ -284,15 +284,15 @@
## (def (return x)
## (All [a]
-## (-> a CompilerState
-## (Either Text (, CompilerState a))))
+## (-> a Compiler
+## (Either Text (, Compiler a))))
## ...)
(_lux_def return
- (_lux_: (#AllT [#None "" "a"
+ (_lux_: (#AllT [(#Some #Nil) "" "a"
(#LambdaT [(#BoundT "a")
- (#LambdaT [CompilerState
+ (#LambdaT [Compiler
(#AppT [(#AppT [Either Text])
- (#TupleT (#Cons [CompilerState
+ (#TupleT (#Cons [Compiler
(#Cons [(#BoundT "a")
#Nil])]))])])])])
(_lux_lambda _ val
@@ -301,15 +301,15 @@
## (def (fail msg)
## (All [a]
-## (-> Text CompilerState
-## (Either Text (, CompilerState a))))
+## (-> Text Compiler
+## (Either Text (, Compiler a))))
## ...)
(_lux_def fail
- (_lux_: (#AllT [#None "" "a"
+ (_lux_: (#AllT [(#Some #Nil) "" "a"
(#LambdaT [Text
- (#LambdaT [CompilerState
+ (#LambdaT [Compiler
(#AppT [(#AppT [Either Text])
- (#TupleT (#Cons [CompilerState
+ (#TupleT (#Cons [Compiler
(#Cons [(#BoundT "a")
#Nil])]))])])])])
(_lux_lambda _ msg
@@ -911,11 +911,11 @@
(fail "Wrong syntax for if")))
## (deftype (Lux a)
-## (-> CompilerState (Either Text (, CompilerState a))))
+## (-> Compiler (Either Text (, Compiler a))))
(def__ #export Lux
Type
(All' [a]
- (->' CompilerState ($' Either Text (#TupleT (list CompilerState (B' a)))))))
+ (->' Compiler ($' Either Text (#TupleT (list Compiler (B' a)))))))
## (defsig (Monad m)
## (: (All [a] (-> a (m a)))
@@ -1246,7 +1246,7 @@
(replace-syntax replacements body)
(reverse targs))]
(return (_lux_: SyntaxList
- (list (`' (#;AllT [#;None (~ ($text self-ident)) (~ ($text harg)) (~ body')])))))))
+ (list (`' (#;AllT [(#;Some #;Nil) (~ ($text self-ident)) (~ ($text harg)) (~ body')])))))))
#None
(fail "'All' arguments must be symbols."))
@@ -1281,7 +1281,7 @@
(#Right [state module-name]))))
(def__ (find-macro' modules current-module module name)
- (-> ($' List (, Text ($' List (, Text (, Bool ($' DefData' (-> ($' List Syntax) ($' StateE CompilerState ($' List Syntax)))))))))
+ (-> ($' List (, Text ($' List (, Text (, Bool ($' DefData' (-> ($' List Syntax) ($' StateE Compiler ($' List Syntax)))))))))
Text Text Text
($' Maybe Macro))
(do Maybe:Monad
@@ -1949,7 +1949,7 @@
#seed seed}
(case (get "lux" modules)
(#Some lux)
- (let [to-alias (map (: (-> (, Text (, Bool (DefData' (-> (List Syntax) (StateE CompilerState (List Syntax))))))
+ (let [to-alias (map (: (-> (, Text (, Bool (DefData' (-> (List Syntax) (StateE Compiler (List Syntax))))))
(List Text))
(lambda [gdef]
(let [[name [export? _]] gdef]
diff --git a/src/lux/type.clj b/src/lux/type.clj
index 105528b8a..a2cf83624 100644
--- a/src/lux/type.clj
+++ b/src/lux/type.clj
@@ -16,14 +16,14 @@
(def $Void (&/V "lux;VariantT" (&/|list)))
(def List
- (&/V "lux;AllT" (&/T (&/V "lux;None" nil) "List" "a"
+ (&/V "lux;AllT" (&/T (&/V "lux;Some" (&/V "lux;Nil" nil)) "lux;List" "a"
(&/V "lux;VariantT" (&/|list (&/T "lux;Nil" Unit)
(&/T "lux;Cons" (&/V "lux;TupleT" (&/|list (&/V "lux;BoundT" "a")
- (&/V "lux;AppT" (&/T (&/V "lux;BoundT" "List")
+ (&/V "lux;AppT" (&/T (&/V "lux;BoundT" "lux;List")
(&/V "lux;BoundT" "a")))))))))))
(def Maybe
- (&/V "lux;AllT" (&/T (&/V "lux;None" nil) "Maybe" "a"
+ (&/V "lux;AllT" (&/T (&/V "lux;Some" (&/V "lux;Nil" nil)) "lux;Maybe" "a"
(&/V "lux;VariantT" (&/|list (&/T "lux;None" Unit)
(&/T "lux;Some" (&/V "lux;BoundT" "a")))))))
@@ -31,7 +31,7 @@
(let [Type (&/V "lux;AppT" (&/T (&/V "lux;BoundT" "Type") (&/V "lux;BoundT" "_")))
TypeEnv (&/V "lux;AppT" (&/T List (&/V "lux;TupleT" (&/|list Text Type))))
TypePair (&/V "lux;TupleT" (&/|list Type Type))]
- (&/V "lux;AppT" (&/T (&/V "lux;AllT" (&/T (&/V "lux;None" nil) "Type" "_"
+ (&/V "lux;AppT" (&/T (&/V "lux;AllT" (&/T (&/V "lux;Some" (&/V "lux;Nil" nil)) "Type" "_"
(&/V "lux;VariantT" (&/|list (&/T "lux;DataT" Text)
(&/T "lux;TupleT" (&/V "lux;AppT" (&/T List Type)))
(&/T "lux;VariantT" TypeEnv)
@@ -49,7 +49,7 @@
(&/V "lux;AllT" (&/T (&/V "lux;None" nil) name arg body)))
(def Bindings
- (fAll "Bindings" "k"
+ (fAll "lux;Bindings" "k"
(fAll "" "v"
(&/V "lux;RecordT" (&/|list (&/T "lux;counter" Int)
(&/T "lux;mappings" (&/V "lux;AppT" (&/T List
@@ -59,7 +59,7 @@
(def Env
(let [bindings (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T Bindings (&/V "lux;BoundT" "k")))
(&/V "lux;BoundT" "v")))]
- (fAll "Env" "k"
+ (fAll "lux;Env" "k"
(fAll "" "v"
(&/V "lux;RecordT"
(&/|list (&/T "lux;name" Text)
@@ -72,7 +72,7 @@
(&/V "lux;TupleT" (&/|list Text Int Int)))
(def Meta
- (fAll "Meta" "m"
+ (fAll "lux;Meta" "m"
(fAll "" "v"
(&/V "lux;VariantT" (&/|list (&/T "lux;Meta" (&/V "lux;TupleT" (&/|list (&/V "lux;BoundT" "m")
(&/V "lux;BoundT" "v")))))))))
@@ -81,10 +81,10 @@
(def Syntax*
(let [Syntax* (&/V "lux;AppT" (&/T (&/V "lux;BoundT" "w")
- (&/V "lux;AppT" (&/T (&/V "lux;BoundT" "Syntax'")
+ (&/V "lux;AppT" (&/T (&/V "lux;BoundT" "lux;Syntax'")
(&/V "lux;BoundT" "w")))))
Syntax*List (&/V "lux;AppT" (&/T List Syntax*))]
- (fAll "Syntax'" "w"
+ (fAll "lux;Syntax'" "w"
(&/V "lux;VariantT" (&/|list (&/T "lux;BoolS" Bool)
(&/T "lux;IntS" Int)
(&/T "lux;RealS" Real)
@@ -104,13 +104,13 @@
(def ^:private SyntaxList (&/V "lux;AppT" (&/T List Syntax)))
(def Either
- (fAll "_" "l"
+ (fAll "lux;Either" "l"
(fAll "" "r"
(&/V "lux;VariantT" (&/|list (&/T "lux;Left" (&/V "lux;BoundT" "l"))
(&/T "lux;Right" (&/V "lux;BoundT" "r")))))))
(def StateE
- (fAll "StateE" "s"
+ (fAll "lux;StateE" "s"
(fAll "" "a"
(&/V "lux;LambdaT" (&/T (&/V "lux;BoundT" "s")
(&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T Either Text))
@@ -129,7 +129,7 @@
)))
(def DefData*
- (fAll "DefData'" ""
+ (fAll "lux;DefData'" ""
(&/V "lux;VariantT" (&/|list (&/T "lux;TypeD" Unit)
(&/T "lux;ValueD" Type)
(&/T "lux;MacroD" (&/V "lux;BoundT" ""))
@@ -139,8 +139,8 @@
(&/V "lux;VariantT" (&/|list (&/T "lux;Local" Int)
(&/T "lux;Global" Ident))))
-(def CompilerState
- (&/V "lux;AppT" (&/T (fAll "CompilerState" ""
+(def $Compiler
+ (&/V "lux;AppT" (&/T (fAll "lux;Compiler" ""
(&/V "lux;RecordT"
(&/|list (&/T "lux;source" Reader)
(&/T "lux;modules" (&/V "lux;AppT" (&/T List (&/V "lux;TupleT"
@@ -150,7 +150,7 @@
(&/V "lux;TupleT" (&/|list Bool
(&/V "lux;AppT" (&/T DefData*
(&/V "lux;LambdaT" (&/T SyntaxList
- (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T StateE (&/V "lux;AppT" (&/T (&/V "lux;BoundT" "CompilerState")
+ (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T StateE (&/V "lux;AppT" (&/T (&/V "lux;BoundT" "lux;Compiler")
(&/V "lux;BoundT" "")))))
SyntaxList)))))))))))))))))
(&/T "lux;module-aliases" (&/V "lux;AppT" (&/T List $Void)))
@@ -164,7 +164,7 @@
(def Macro
(&/V "lux;LambdaT" (&/T SyntaxList
- (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T StateE CompilerState))
+ (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T StateE $Compiler))
SyntaxList)))))
(defn bound? [id]
@@ -433,23 +433,25 @@
(and (type= xlambda ylambda) (type= xparam yparam))
[["lux;AllT" [xenv xname xarg xbody]] ["lux;AllT" [yenv yname yarg ybody]]]
- (and (= xname yname)
- (= xarg yarg)
- ;; (matchv ::M/objects [xenv yenv]
- ;; [["lux;None" _] ["lux;None" _]]
- ;; true
-
- ;; [["lux;Some" xenv*] ["lux;Some" yenv*]]
- ;; (&/fold (fn [old bname]
- ;; (and old
- ;; (type= (&/|get bname xenv*) (&/|get bname yenv*))))
- ;; (= (&/|length xenv*) (&/|length yenv*))
- ;; (&/|keys xenv*))
-
- ;; [_ _]
- ;; false)
- (type= xbody ybody)
- )
+ (or (and (not= "" xname)
+ (= xname yname))
+ (and (= xname yname)
+ (= xarg yarg)
+ ;; (matchv ::M/objects [xenv yenv]
+ ;; [["lux;None" _] ["lux;None" _]]
+ ;; true
+
+ ;; [["lux;Some" xenv*] ["lux;Some" yenv*]]
+ ;; (&/fold (fn [old bname]
+ ;; (and old
+ ;; (type= (&/|get bname xenv*) (&/|get bname yenv*))))
+ ;; (= (&/|length xenv*) (&/|length yenv*))
+ ;; (&/|keys xenv*))
+
+ ;; [_ _]
+ ;; false)
+ (type= xbody ybody)
+ ))
[_ _]
false
--
cgit v1.2.3