git.iko.soy/elk
on master help sign in
Add type validation for loopback declarations
commit09d86de2ede7871359c502a4587131f84fe11077 authorEvan Czaplicki <info@elm-lang.org> dateSat 28 Feb 2015, 08:51 (12 years ago) parentedfca84
3 files changed+52−12
compare with master
unifiedsplit
src/AST/Variable.hs+10 src/Transform/Expression.hs+18−11 src/Type/ExtraChecks.hs+24−1
src/AST/Variable.hs+10
@@ -68,6 +68,11 @@ isStream =
6868 is ["Signal"] "Stream"
6969
7070
71+isWritableStream :: Canonical -> Bool
72+isWritableStream =
73+ is ["Signal"] "WritableStream"
74+
75+
7176isVarying :: Canonical -> Bool
7277isVarying =
7378 is ["Signal"] "Varying"
@@ -78,6 +83,11 @@ isPromise =
7883 is ["Promise"] "Promise"
7984
8085
86+isResult :: Canonical -> Bool
87+isResult =
88+ is ["Result"] "Result"
89+
90+
8191isList :: Canonical -> Bool
8292isList v =
8393 v == Canonical BuiltIn "List"
src/Transform/Expression.hs+18−11
@@ -13,30 +13,35 @@ crawlLet
1313 -> Expr ann def var
1414 -> Either a (Expr ann def' var)
1515crawlLet =
16− crawl (\_ _ -> return ()) (\_ _ -> return ())
16+ crawl
17+ (\_ _ -> return ())
18+ (\_ _ -> return ())
19+ (\_ _ _ -> return ())
1720
1821
1922checkWires
2023 :: (String -> CanonicalType -> Either a ())
2124 -> (String -> CanonicalType -> Either a ())
25+ -> (String -> CanonicalType -> Bool -> Either a ())
2226 -> Canonical.Expr
2327 -> Either a Canonical.Expr
24−checkWires inputCheck outputCheck expr =
25− crawl inputCheck outputCheck (mapM checkDef) expr
28+checkWires inputCheck outputCheck loopbackCheck expr =
29+ crawl inputCheck outputCheck loopbackCheck (mapM checkDef) expr
2630 where
2731 checkDef def@(Canonical.Definition _ body _) =
28− do _ <- checkWires inputCheck outputCheck body
32+ do _ <- checkWires inputCheck outputCheck loopbackCheck body
2933 return def
3034
3135
3236crawl
3337 :: (String -> Type var -> Either a ())
3438 -> (String -> Type var -> Either a ())
39+ -> (String -> Type var -> Bool -> Either a ())
3540 -> ([def] -> Either a [def'])
3641 -> Expr ann def var
3742 -> Either a (Expr ann def' var)
38−crawl inputCheck outputCheck defsTransform =
39− go
43+crawl inputCheck outputCheck loopbackCheck defsTransform expression =
44+ go expression
4045 where
4146 go (A srcSpan expr) =
4247 A srcSpan <$>
@@ -101,8 +106,10 @@ crawl inputCheck outputCheck defsTransform =
101106 Output name st <$> go signal
102107
103108 Loopback name st maybeExpr ->
104− case maybeExpr of
105− Nothing ->
106− error "loopback check"
107− Just expr ->
108− error "loopback check"
109+ do let hasExpr = maybe False (const True) maybeExpr
110+ loopbackCheck name st hasExpr
111+ case maybeExpr of
112+ Nothing ->
113+ return (Loopback name st Nothing)
114+ Just expr ->
115+ (Loopback name st . Just) <$> go expr
src/Type/ExtraChecks.hs+24−1
@@ -121,7 +121,7 @@ data Direction = In | Out
121121
122122wireTypes :: (Monad m) => Canonical.Expr -> ErrorT [P.Doc] m ()
123123wireTypes expr =
124− case Expr.checkWires (checkWires In) (checkWires Out) expr of
124+ case Expr.checkWires (checkWires In) (checkWires Out) checkLoobacks expr of
125125 Left err -> throwError err
126126 Right _ -> return ()
127127
@@ -254,6 +254,29 @@ wireError name direction rootType localType problemMessage =
254254 dir "input" "output"
255255
256256
257+checkLoobacks :: String -> ST.CanonicalType -> Bool -> Either [P.Doc] ()
258+checkLoobacks name tipe hasExpr =
259+ checkLoobacksHelp name tipe tipe hasExpr
260+
261+
262+checkLoobacksHelp :: String -> ST.CanonicalType -> ST.CanonicalType -> Bool -> Either [P.Doc] ()
263+checkLoobacksHelp name rootType tipe hasExpr =
264+ case tipe of
265+ ST.Aliased _ t ->
266+ checkLoobacksHelp name rootType t hasExpr
267+
268+ ST.App (ST.Type signal) [ ST.App (ST.Type result) [_,_] ]
269+ | hasExpr && Var.isStream signal && Var.isResult result ->
270+ return ()
271+
272+ ST.App (ST.Type signal) [ _ ]
273+ | not hasExpr && Var.isWritableStream signal ->
274+ return ()
275+
276+ _ ->
277+ throw [ P.text "no good loopback" ]
278+
279+
257280-- INFINITE TYPES
258281
259282occurs :: (String, TT.Variable) -> StateT TS.SolverState IO ()