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