git.iko.soy/elk
on master help sign in
Add type validation for loopback declarations
09d86deEvan Czaplicki
src/AST/Variable.hs+10
compare with master
unifiedsplit
@@ -68,6 +68,11 @@ isStream =
68 is ["Signal"] "Stream"
68 is ["Signal"] "Stream"
69
69
70
70
71+isWritableStream :: Canonical -> Bool
72+isWritableStream =
73+ is ["Signal"] "WritableStream"
74+
75+
71isVarying :: Canonical -> Bool
76isVarying :: Canonical -> Bool
72isVarying =
77isVarying =
73 is ["Signal"] "Varying"
78 is ["Signal"] "Varying"
@@ -78,6 +83,11 @@ isPromise =
78 is ["Promise"] "Promise"
83 is ["Promise"] "Promise"
79
84
80
85
86+isResult :: Canonical -> Bool
87+isResult =
88+ is ["Result"] "Result"
89+
90+
81isList :: Canonical -> Bool
91isList :: Canonical -> Bool
82isList v =
92isList v =
83 v == Canonical BuiltIn "List"
93 v == Canonical BuiltIn "List"
src/Transform/Expression.hs+18−11
@@ -13,30 +13,35 @@ crawlLet
13 -> Expr ann def var
13 -> Expr ann def var
14 -> Either a (Expr ann def' var)
14 -> Either a (Expr ann def' var)
15crawlLet =
15crawlLet =
16+ crawl
16− crawl (\_ _ -> return ()) (\_ _ -> return ())
17+ (\_ _ -> return ())
18+ (\_ _ -> return ())
19+ (\_ _ _ -> return ())
17
20
18
21
19checkWires
22checkWires
20 :: (String -> CanonicalType -> Either a ())
23 :: (String -> CanonicalType -> Either a ())
21 -> (String -> CanonicalType -> Either a ())
24 -> (String -> CanonicalType -> Either a ())
25+ -> (String -> CanonicalType -> Bool -> Either a ())
22 -> Canonical.Expr
26 -> Canonical.Expr
23 -> Either a Canonical.Expr
27 -> Either a Canonical.Expr
24−checkWires inputCheck outputCheck expr =
28+checkWires inputCheck outputCheck loopbackCheck expr =
25− crawl inputCheck outputCheck (mapM checkDef) expr
29+ crawl inputCheck outputCheck loopbackCheck (mapM checkDef) expr
26 where
30 where
27 checkDef def@(Canonical.Definition _ body _) =
31 checkDef def@(Canonical.Definition _ body _) =
28− do _ <- checkWires inputCheck outputCheck body
32+ do _ <- checkWires inputCheck outputCheck loopbackCheck body
29 return def
33 return def
30
34
31
35
32crawl
36crawl
33 :: (String -> Type var -> Either a ())
37 :: (String -> Type var -> Either a ())
34 -> (String -> Type var -> Either a ())
38 -> (String -> Type var -> Either a ())
39+ -> (String -> Type var -> Bool -> Either a ())
35 -> ([def] -> Either a [def'])
40 -> ([def] -> Either a [def'])
36 -> Expr ann def var
41 -> Expr ann def var
37 -> Either a (Expr ann def' var)
42 -> Either a (Expr ann def' var)
38−crawl inputCheck outputCheck defsTransform =
43+crawl inputCheck outputCheck loopbackCheck defsTransform expression =
39− go
44+ go expression
40 where
45 where
41 go (A srcSpan expr) =
46 go (A srcSpan expr) =
42 A srcSpan <$>
47 A srcSpan <$>
@@ -101,8 +106,10 @@ crawl inputCheck outputCheck defsTransform =
101 Output name st <$> go signal
106 Output name st <$> go signal
102
107
103 Loopback name st maybeExpr ->
108 Loopback name st maybeExpr ->
109+ do let hasExpr = maybe False (const True) maybeExpr
110+ loopbackCheck name st hasExpr
104− case maybeExpr of
111+ case maybeExpr of
105− Nothing ->
112+ Nothing ->
106− error "loopback check"
113+ return (Loopback name st Nothing)
107− Just expr ->
114+ Just expr ->
108− error "loopback check"
115+ (Loopback name st . Just) <$> go expr
src/Type/ExtraChecks.hs+24−1
@@ -121,7 +121,7 @@ data Direction = In | Out
121
121
122wireTypes :: (Monad m) => Canonical.Expr -> ErrorT [P.Doc] m ()
122wireTypes :: (Monad m) => Canonical.Expr -> ErrorT [P.Doc] m ()
123wireTypes expr =
123wireTypes expr =
124− case Expr.checkWires (checkWires In) (checkWires Out) expr of
124+ case Expr.checkWires (checkWires In) (checkWires Out) checkLoobacks expr of
125 Left err -> throwError err
125 Left err -> throwError err
126 Right _ -> return ()
126 Right _ -> return ()
127
127
@@ -254,6 +254,29 @@ wireError name direction rootType localType problemMessage =
254 dir "input" "output"
254 dir "input" "output"
255
255
256
256
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+
257-- INFINITE TYPES
280-- INFINITE TYPES
258
281
259occurs :: (String, TT.Variable) -> StateT TS.SolverState IO ()
282occurs :: (String, TT.Variable) -> StateT TS.SolverState IO ()