git.iko.soy/elk
on master help sign in
Use fewer local vars
commitc33ca8af94d6576af26e9d671ef95d78512520e9 authorEvan Czaplicki <info@elm-lang.org> dateWed 28 May 2014, 19:05 (12 years ago) parentfcd5d23
3 files changed+84−23
compare with master
unifiedsplit
compiler/AST/Expression/General.hs+2−2 compiler/AST/Variable.hs+51−9 compiler/Transform/Canonicalize.hs+31−12
compiler/AST/Expression/General.hs+2−2
@@ -83,7 +83,7 @@ saveEnvName = "_save_the_environment!!!"
8383
8484dummyLet :: (Pretty def) => [def] -> Expr Annotation.Region def Var.Canonical
8585dummyLet defs =
86− Annotation.none $ Let defs (Annotation.none $ localVar saveEnvName)
86+ Annotation.none $ Let defs (Annotation.none $ Var (Var.builtin saveEnvName))
8787
8888instance (Pretty def, Pretty var, Var.ToString var) => Pretty (Expr' ann def var) where
8989 pretty expr =
@@ -191,5 +191,5 @@ prettyParens (Annotation.A _ expr) = parensIf needed (pretty expr)
191191 MultiIf _ -> True
192192 Let _ _ -> True
193193 Case _ _ -> True
194− Data name (_:_) -> name /= "::"
194+ Data name (_:_) -> not (name == "::" || Help.isTuple name)
195195 _ -> False
compiler/AST/Variable.hs+51−9
@@ -4,15 +4,16 @@ module AST.Variable where
44import Data.Binary
55import Control.Applicative ((<$>), (<*>))
66import Text.PrettyPrint as P
7+import qualified AST.Helpers as Help
78import AST.PrettyPrint
89
910newtype Raw = Raw String
1011 deriving (Eq,Ord,Show)
1112
1213data Home
13− = Local
14− | BuiltIn
14+ = BuiltIn
1515 | Module !String
16+ | Local
1617 deriving (Eq,Ord,Show)
1718
1819data Canonical = Canonical
@@ -26,6 +27,47 @@ local x = Canonical Local x
2627builtin :: String -> Canonical
2728builtin x = Canonical BuiltIn x
2829
30+-- To help with pattern matching on some common canonical variables:
31+is :: String -> String -> Canonical -> Bool
32+is home name var =
33+ var == Canonical (Module home) name
34+
35+isJson :: Canonical -> Bool
36+isJson = is "Json" "Value"
37+
38+isMaybe :: Canonical -> Bool
39+isMaybe = is "Maybe" "Maybe"
40+
41+isArray :: Canonical -> Bool
42+isArray = is "Array" "Array"
43+
44+isSignal :: Canonical -> Bool
45+isSignal = is "Signal" "Signal"
46+
47+isList :: Canonical -> Bool
48+isList v = v == Canonical BuiltIn "_List"
49+
50+isTuple :: Canonical -> Bool
51+isTuple v =
52+ case v of
53+ Canonical BuiltIn name -> Help.isTuple name
54+ _ -> False
55+
56+isPrimitive :: Canonical -> Bool
57+isPrimitive v =
58+ case v of
59+ Canonical BuiltIn name -> name `elem` ["Int","Float","String","Bool"]
60+ _ -> False
61+
62+isPrim :: String -> Canonical -> Bool
63+isPrim prim v =
64+ case v of
65+ Canonical BuiltIn name -> name == prim
66+ _ -> False
67+
68+isText :: Canonical -> Bool
69+isText = is "Text" "Text"
70+
2971class ToString a where
3072 toString :: a -> String
3173
@@ -35,9 +77,9 @@ instance ToString Raw where
3577instance ToString Canonical where
3678 toString (Canonical home name) =
3779 case home of
38− Local -> name
3980 BuiltIn -> name
4081 Module path -> path ++ "." ++ name
82+ Local -> name
4183
4284-- | A listing of values. Something like (a,b,c) or (..) or (a,b,..)
4385data Listing a = Listing
@@ -78,15 +120,15 @@ instance Pretty Value where
78120instance Binary Canonical where
79121 put (Canonical home name) =
80122 case home of
81− Local -> putWord8 0 >> put name
82− BuiltIn -> putWord8 1 >> put name
83− Module path -> putWord8 2 >> put path >> put name
123+ BuiltIn -> putWord8 0 >> put name
124+ Module path -> putWord8 1 >> put path >> put name
125+ Local -> putWord8 2 >> put name
84126
85127 get = do tag <- getWord8
86128 case tag of
87− 0 -> Canonical Local <$> get
88− 1 -> Canonical BuiltIn <$> get
89− 2 -> Canonical . Module <$> get <*> get
129+ 0 -> Canonical BuiltIn <$> get
130+ 1 -> Canonical . Module <$> get <*> get
131+ 2 -> Canonical Local <$> get
90132 _ -> error "Unexpected tag when deserializing canonical variable"
91133
92134instance Binary Value where
compiler/Transform/Canonicalize.hs+31−12
@@ -30,10 +30,11 @@ import qualified Transform.SortDefinitions as Transform
3030import qualified Transform.Declaration as Transform
3131
3232environment :: Interfaces -> Module.ValidModule -> Either [Doc] Environment
33−environment interfaces (Module.Module _ _ _ ims decls) =
33+environment interfaces m@(Module.Module _ _ _ ims decls) =
3434 do () <- allImportsAvailable interfaces ims
3535 nonLocalEnv <- foldM (toEnv interfaces) Env.builtIns ims
36− foldM addDecl nonLocalEnv decls
36+ let moduleName = Module.getName m
37+ foldM (addDecl moduleName) nonLocalEnv decls
3738
3839toEnv :: Interfaces -> Environment -> (String, ImportMethod) -> Either [Doc] Environment
3940toEnv interfaces environ (name,method)
@@ -72,9 +73,9 @@ addValue :: String -> Module.Interface -> Environment -> Var.Value
7273 -> Either [Doc] Environment
7374addValue name interface env value =
7475 let insert' x = insert x (Var.Canonical (Var.Module name) x)
75− notFound x = Left [ P.text $
76− "Import Error: Could not import value '" ++ name ++ "." ++ x ++ "'.\n" ++
77− " It is not exported by module " ++ name ++ "." ]
76+ msg x = "Import Error: Could not import value '" ++ name ++ "." ++ x ++
77+ "'.\n It is not exported by module " ++ name ++ "."
78+ notFound x = Left [ P.text (msg x) ]
7879 in
7980 case value of
8081 Var.Value x
@@ -106,8 +107,9 @@ addValue name interface env value =
106107 [] -> return names
107108 c:_ -> notFound c
108109
109−addDecl :: Environment -> D.ValidDecl -> Either [Doc] Environment
110−addDecl env decl =
110+addDecl :: String -> Environment -> D.ValidDecl -> Either [Doc] Environment
111+addDecl moduleName env decl =
112+ let typeVar = Var.Canonical (Var.Module moduleName) in
111113 case decl of
112114 D.Definition (Valid.Definition pattern _ _) ->
113115 return $ env
@@ -118,19 +120,19 @@ addDecl env decl =
118120 D.Datatype name _ ctors ->
119121 return $ env
120122 { _values = addCtors (_values env)
121− , _adts = insert name (Var.local name) (_adts env)
123+ , _adts = insert name (typeVar name) (_adts env)
122124 , _patterns = addCtors (_patterns env)
123125 }
124126 where
125127 addCtors e = foldr add e (map fst ctors)
126− add name e = insert name (Var.local name) e
128+ add name e = insert name (typeVar name) e
127129
128130 D.TypeAlias name tvars alias ->
129131 do alias' <- Either.either throw return (tipe env alias)
130132 return $ env
131− { _aliases = insert name (Var.local name, tvars, alias') (_aliases env)
133+ { _aliases = insert name (typeVar name, tvars, alias') (_aliases env)
132134 , _values = case alias of
133− Type.Record _ _ -> insert name (Var.local name) (_values env)
135+ Type.Record _ _ -> insert name (typeVar name) (_values env)
134136 _ -> _values env
135137 }
136138 where
@@ -158,7 +160,7 @@ module' interfaces modul@(Module.Module _ _ exs _ decls) =
158160 body :: [D.CanonicalDecl] -> CanonicalBody
159161 body decls =
160162 CanonicalBody
161− { program = Transform.sortDefs . dummyLet $ Transform.toExpr decls
163+ { program = Transform.sortDefs . dummyLet $ Transform.toExpr (Module.getName modul) decls
162164 , types = Map.empty
163165 , datatypes = Map.fromList [ (name,(vars,ctors)) | Datatype name vars ctors <- decls ]
164166 , fixities = [ (assoc,level,op) | Fixity assoc level op <- decls ]
@@ -198,6 +200,23 @@ delist fullList (Var.Listing partial open)
198200
199201 _ -> go list xs partial
200202
203+filterExports :: Module.Types -> [Var.Value] -> Module.Types
204+filterExports types values =
205+ Map.fromList (concatMap getValue values)
206+ where
207+ getValue :: Var.Value -> [(String, Type.CanonicalType)]
208+ getValue value =
209+ case value of
210+ Var.Value x -> get x
211+ Var.Alias x -> get x
212+ Var.ADT _ (Var.Listing ctors _) -> concatMap get ctors
213+
214+ get :: String -> [(String, Type.CanonicalType)]
215+ get x =
216+ case Map.lookup x types of
217+ Just t -> [(x,t)]
218+ Nothing -> []
219+
201220declToValue :: D.ValidDecl -> [Var.Value]
202221declToValue decl =
203222 case decl of