git.iko.soy/elk
on 9cda2b2 help sign in
elk/src/Transform/Expression.hs
59 lines 2.6 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2module Transform.Expression (crawlLet, checkPorts) where
4import Control.Applicative ((<$>),(<*>))
5import AST.Annotation ( Annotated(A) )
6import AST.Expression.General
7import qualified AST.Expression.Canonical as Canonical
8import AST.Type (Type, CanonicalType)
10crawlLet :: ([def] -> Either a [def'])
11 -> Expr ann def var
12 -> Either a (Expr ann def' var)
13crawlLet = crawl (\_ _ -> return ()) (\_ _ -> return ())
15checkPorts :: (String -> CanonicalType -> Either a ())
16 -> (String -> CanonicalType -> Either a ())
17 -> Canonical.Expr
18 -> Either a Canonical.Expr
19checkPorts inCheck outCheck expr =
20 crawl inCheck outCheck (mapM checkDef) expr
21 where
22 checkDef def@(Canonical.Definition _ body _) =
23 do _ <- checkPorts inCheck outCheck body
24 return def
26crawl :: (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)
31crawl 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 es -> Markdown uid md <$> mapM go es
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