e75937e · elk · git.iko.soy

git.iko.soy/elk

Final fixes for use of type schemes.

commite75937e958c3b0c38b6735520ef1ed1663258934 authorevancz <info@elm-lang.org> dateThu 19 Jul 2012, 11:53 (14 years ago) parent9a51377

3 files changed+17−18

compare with master

unifiedsplit

elm/src/Initialize.hs+3−2 elm/src/Parse/ParseTypes.hs+11−12 elm/src/Parse/Parser.hs+3−4

elm/src/Initialize.hs+3−2

@@ -8,6 +8,7 @@ import Parser (parseProgram)

88import Hints

99import Unify

1010import Rename

11+import Types ((-:))

1112import Optimize

1213

1314

@@ -15,7 +16,7 @@ initialize str = do

1516 (Module name ex im defs (ims,exs), tipes) <- parseProgram str

1617 let (Let ds _) = rename . Let defs $ Var "_"

1718 let dict n = maybe n id . lookup n $ zip (map fst defs) (map fst ds)

18− let allHints = liftM2 (\a b -> a ++ b ++ ffiHints (ims,exs)) hints tipes

19+ let allHints = hints ++ tipes ++ ffiHints (ims,exs)

1920 subs <- unify allHints . Let ds $ checkFFI dict ims exs

2021 let Let defs' _ = optimize (Let ds $ Var "_")

2122 let im' = if any ((=="Prelude") . fst) im then im else

@@ -25,7 +26,7 @@ initialize str = do

2526

2627

2728ffiHints (ims,exs) =

28− map (\(_,_,n,t) -> (n,t)) ims ++ map (\(_,n,t) -> (n,t)) exs

29+ map (\(_,_,n,t) -> n -: t) ims ++ map (\(_,n,t) -> n -: t) exs

2930

3031checkFFI dict ims exs = list $ ims' ++ exs'

3132 where ims' = map (\(_,b,n,_)-> Binop "==" (Var n) (App (Var "constant") b)) ims

elm/src/Parse/ParseTypes.hs+11−12

@@ -52,7 +52,7 @@ typeExpr = do

5252typeConstructor :: (Monad m) => ParsecT [Char] u m (String, [ParseType])

5353typeConstructor = (,) <$> (capVar <?> "another type constructor") <*> spacePrefix (typeSimple <|> typeUnambiguous)

5454

55−datatype :: (Monad m) => ParsecT [Char] u m ([String], [Expr], GuidCounter [Type])

55+datatype :: (Monad m) => ParsecT [Char] u m ([String], [Expr], [Scheme])

5656datatype = do

5757 reserved "data" <?> "datatype definition (data T = A | B | ...)"

5858 forcedWS ; name <- capVar <?> "name of data-type" ; args <- spacePrefix lowVar

@@ -65,22 +65,21 @@ beta = liftM VarT guid

6565toFunc (name,args) = foldr Lambda (Data name $ map Var argNames) argNames

6666 where argNames = map (("a"++) . show) [1..length args]

6767

68−toTypes name args constructors = do

69− pairs <- mapM (\x -> (,) x `liftM` guid) args

70− return $ map (toType pairs . ADT name $ map (VarT . snd) pairs) constructors

68+toTypes name args constructors =

69+ map (toType pairs . ADT name $ map (VarT . snd) pairs) constructors

70+ where pairs = zip args [1..length args]

7171

7272toType pairs outType (name,args) =

73− foldr (==>) outType (map toT args)

74− where toT (LambdaPT t1 t2) = toT t1 ==> toT t2

73+ Forall [1..n+2] cs $ foldr (==>) outType (map toT args)

74+ where n = length pairs

75+ cs = [ VarT (n+1) :<: time, VarT (n+2) :<: number ]

76+ toT (LambdaPT t1 t2) = toT t1 ==> toT t2

7577 toT (ADTPT name args) = ADT name $ map toT args

7678 toT (VarPT x@(c:_))

7779 | isLower c = VarT . fromMaybe (-1) $ lookup x pairs

78− | otherwise = case x of "Int" -> IntT

79− "Number" -> IntT

80− "String" -> StringT

81− "Char" -> CharT

82− "Bool" -> BoolT

83− _ -> ADT x []

80+ | x == "Time" = VarT (n+1)

81+ | x == "Number" = VarT (n+2)

82+ | otherwise = ADT x []

8483

8584toForeignType (LambdaPT t1 t2) =

8685 fail $ "Elm's JavaScript event interface does not yet handle functions. " ++

elm/src/Parse/Parser.hs+3−4

@@ -21,9 +21,8 @@ freshDef = commitIf (freshLine >> (letter <|> char '_')) $ do

2121defs1 = do d <- datatype <|> def <?> "at least one datatype or variable definition"

2222 (d:) <$> many freshDef

2323

24−defs = do

25− (fss,ess,tss) <- unzip3 <$> defs1

26− return (concat fss, concat ess, concat `liftM` sequence tss)

24+defs = do (fss,ess,tss) <- unzip3 <$> defs1

25+ return (concat fss, concat ess, concat tss)

2726

2827program = do

2928 optional freshLine

@@ -33,7 +32,7 @@ program = do

3332 jsffi <- foreignDefs `followedBy` freshLine <|> return ([],[])

3433 (vs,es,ts) <- defs

3534 optional freshLine ; optional spaces ; eof

36− return (Module names exports is (zip vs es) jsffi, zip vs `liftM` ts)

35+ return (Module names exports is (zip vs es) jsffi, zip vs ts)

3736

3837parseProgram source =

3938 case parse program "" source of