git.iko.soy/elk
on e123780 help sign in
elk/compiler/Transform/Expression.hs
58 lines 2.5 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2module Transform.Expression (crawlLet, checkPorts) where
4import Control.Applicative ((<$>),(<*>))
5import SourceSyntax.Annotation ( Annotated(A) )
6import SourceSyntax.Expression
7import SourceSyntax.Type (Type)
9crawlLet :: ([def] -> Either a [def'])
10 -> GeneralExpr ann def var
11 -> Either a (GeneralExpr ann def' var)
12crawlLet = crawl (\_ _ -> return ()) (\_ _ -> return ())
14checkPorts :: (String -> Type -> Either a ())
15 -> (String -> Type -> Either a ())
16 -> Expr
17 -> Either a Expr
18checkPorts inCheck outCheck expr =
19 crawl inCheck outCheck (mapM checkDef) expr
20 where
21 checkDef def@(Definition _ body _) =
22 do _ <- checkPorts inCheck outCheck body
23 return def
25crawl :: (String -> Type -> Either a ())
26 -> (String -> Type -> Either a ())
27 -> ([def] -> Either a [def'])
28 -> GeneralExpr ann def var
29 -> Either a (GeneralExpr ann def' var)
30crawl portInCheck portOutCheck defsTransform = go
31 where
32 go (A srcSpan expr) =
33 A srcSpan <$>
34 case expr of
35 Var x -> return (Var x)
36 Lambda p e -> Lambda p <$> go e
37 Binop op e1 e2 -> Binop op <$> go e1 <*> go e2
38 Case e cases -> Case <$> go e <*> mapM (\(p,b) -> (,) p <$> go b) cases
39 Data name es -> Data name <$> mapM go es
40 Literal lit -> return (Literal lit)
41 Range e1 e2 -> Range <$> go e1 <*> go e2
42 ExplicitList es -> ExplicitList <$> mapM go es
43 App e1 e2 -> App <$> go e1 <*> go e2
44 MultiIf branches -> MultiIf <$> mapM (\(b,e) -> (,) <$> go b <*> go e) branches
45 Access e lbl -> Access <$> go e <*> return lbl
46 Remove e lbl -> Remove <$> go e <*> return lbl
47 Insert e lbl v -> Insert <$> go e <*> return lbl <*> go v
48 Modify e fields -> Modify <$> go e <*> mapM (\(k,v) -> (,) k <$> go v) fields
49 Record fields -> Record <$> mapM (\(k,v) -> (,) k <$> go v) fields
50 Markdown uid md es -> Markdown uid md <$> mapM go es
51 Let defs body -> Let <$> defsTransform defs <*> go body
52 GLShader uid src gltipe -> return $ GLShader uid src gltipe
53 PortIn name st ->
54 do portInCheck name st
55 return $ PortIn name st
56 PortOut name st signal ->
57 do portOutCheck name st
58 PortOut name st <$> go signal