@@ -7,15 +7,19 @@ import AST.Expression.General
77import qualified AST.Expression.Canonical as Canonical
88import AST.Type (Type, CanonicalType)
99
10−crawlLet :: ([def] -> Either a [def'])
11− -> Expr ann def var
12− -> Either a (Expr ann def' var)
13−crawlLet = crawl (\_ _ -> return ()) (\_ _ -> return ())
14−
15−checkPorts :: (String -> CanonicalType -> Either a ())
16− -> (String -> CanonicalType -> Either a ())
17− -> Canonical.Expr
18− -> Either a Canonical.Expr
10+crawlLet
11+ :: ([def] -> Either a [def'])
12+ -> Expr ann def var
13+ -> Either a (Expr ann def' var)
14+crawlLet =
15+ crawl (\_ _ -> return ()) (\_ _ -> return ())
16+
17+
18+checkPorts
19+ :: (String -> CanonicalType -> Either a ())
20+ -> (String -> CanonicalType -> Either a ())
21+ -> Canonical.Expr
22+ -> Either a Canonical.Expr
1923checkPorts inCheck outCheck expr =
2024 crawl inCheck outCheck (mapM checkDef) expr
2125 where
@@ -23,37 +27,77 @@ checkPorts inCheck outCheck expr =
2327 do _ <- checkPorts inCheck outCheck body
2428 return def
2529
26−crawl :: (String -> Type var -> Either a ())
27− -> (String -> Type var -> Either a ())
28− -> ([def] -> Either a [def'])
29− -> Expr ann def var
30− -> Either a (Expr ann def' var)
31−crawl portInCheck portOutCheck defsTransform = go
32− where
33− go (A srcSpan expr) =
34− A srcSpan <$>
35− case expr of
36− Var x -> return (Var x)
37− Lambda p e -> Lambda p <$> go e
38− Binop op e1 e2 -> Binop op <$> go e1 <*> go e2
39− Case e cases -> Case <$> go e <*> mapM (\(p,b) -> (,) p <$> go b) cases
40− Data name es -> Data name <$> mapM go es
41− Literal lit -> return (Literal lit)
42− Range e1 e2 -> Range <$> go e1 <*> go e2
43− ExplicitList es -> ExplicitList <$> mapM go es
44− App e1 e2 -> App <$> go e1 <*> go e2
45− MultiIf branches -> MultiIf <$> mapM (\(b,e) -> (,) <$> go b <*> go e) branches
46− Access e lbl -> Access <$> go e <*> return lbl
47− Remove e lbl -> Remove <$> go e <*> return lbl
48− Insert e lbl v -> Insert <$> go e <*> return lbl <*> go v
49− Modify e fields -> Modify <$> go e <*> mapM (\(k,v) -> (,) k <$> go v) fields
50− Record fields -> Record <$> mapM (\(k,v) -> (,) k <$> go v) fields
51− Markdown uid md -> return $ Markdown uid md
52− Let defs body -> Let <$> defsTransform defs <*> go body
53− GLShader uid src gltipe -> return $ GLShader uid src gltipe
54− PortIn name st ->
55− do portInCheck name st
56− return $ PortIn name st
57− PortOut name st signal ->
58− do portOutCheck name st
59− PortOut name st <$> go signal
30+
31+crawl
32+ :: (String -> Type var -> Either a ())
33+ -> (String -> Type var -> Either a ())
34+ -> ([def] -> Either a [def'])
35+ -> Expr ann def var
36+ -> Either a (Expr ann def' var)
37+crawl portInCheck portOutCheck defsTransform =
38+ go
39+ where
40+ go (A srcSpan expr) =
41+ A srcSpan <$>
42+ case expr of
43+ Var x ->
44+ return (Var x)
45+
46+ Lambda p e ->
47+ Lambda p <$> go e
48+
49+ Binop op e1 e2 ->
50+ Binop op <$> go e1 <*> go e2
51+
52+ Case e cases ->
53+ Case <$> go e <*> mapM (\(p,b) -> (,) p <$> go b) cases
54+
55+ Data name es ->
56+ Data name <$> mapM go es
57+
58+ Literal lit ->
59+ return (Literal lit)
60+
61+ Range e1 e2 ->
62+ Range <$> go e1 <*> go e2
63+
64+ ExplicitList es ->
65+ ExplicitList <$> mapM go es
66+
67+ App e1 e2 ->
68+ App <$> go e1 <*> go e2
69+
70+ MultiIf branches ->
71+ MultiIf <$> mapM (\(b,e) -> (,) <$> go b <*> go e) branches
72+
73+ Access e lbl ->
74+ Access <$> go e <*> return lbl
75+
76+ Remove e lbl ->
77+ Remove <$> go e <*> return lbl
78+
79+ Insert e lbl v ->
80+ Insert <$> go e <*> return lbl <*> go v
81+
82+ Modify e fields ->
83+ Modify <$> go e <*> mapM (\(k,v) -> (,) k <$> go v) fields
84+
85+ Record fields ->
86+ Record <$> mapM (\(k,v) -> (,) k <$> go v) fields
87+
88+ Markdown uid md ->
89+ return $ Markdown uid md
90+
91+ Let defs body ->
92+ Let <$> defsTransform defs <*> go body
93+
94+ GLShader uid src gltipe ->
95+ return $ GLShader uid src gltipe
96+
97+ PortIn name st ->
98+ do portInCheck name st
99+ return $ PortIn name st
100+
101+ PortOut name st signal ->
102+ do portOutCheck name st
103+ PortOut name st <$> go signal