git.iko.soy/elk
on 396fd33 help sign in
elk/src/Transform/Expression.hs
103 lines 2.7 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
11 :: ([def] -> Either a [def'])
12 -> Expr ann def var
13 -> Either a (Expr ann def' var)
14crawlLet =
15 crawl (\_ _ -> return ()) (\_ _ -> return ())
18checkPorts
19 :: (String -> CanonicalType -> Either a ())
20 -> (String -> CanonicalType -> Either a ())
21 -> Canonical.Expr
22 -> Either a Canonical.Expr
23checkPorts inCheck outCheck expr =
24 crawl inCheck outCheck (mapM checkDef) expr
25 where
26 checkDef def@(Canonical.Definition _ body _) =
27 do _ <- checkPorts inCheck outCheck body
28 return def
31crawl
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)
37crawl 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)
46 Lambda p e ->
47 Lambda p <$> go e
49 Binop op e1 e2 ->
50 Binop op <$> go e1 <*> go e2
52 Case e cases ->
53 Case <$> go e <*> mapM (\(p,b) -> (,) p <$> go b) cases
55 Data name es ->
56 Data name <$> mapM go es
58 Literal lit ->
59 return (Literal lit)
61 Range e1 e2 ->
62 Range <$> go e1 <*> go e2
64 ExplicitList es ->
65 ExplicitList <$> mapM go es
67 App e1 e2 ->
68 App <$> go e1 <*> go e2
70 MultiIf branches ->
71 MultiIf <$> mapM (\(b,e) -> (,) <$> go b <*> go e) branches
73 Access e lbl ->
74 Access <$> go e <*> return lbl
76 Remove e lbl ->
77 Remove <$> go e <*> return lbl
79 Insert e lbl v ->
80 Insert <$> go e <*> return lbl <*> go v
82 Modify e fields ->
83 Modify <$> go e <*> mapM (\(k,v) -> (,) k <$> go v) fields
85 Record fields ->
86 Record <$> mapM (\(k,v) -> (,) k <$> go v) fields
88 Markdown uid md ->
89 return $ Markdown uid md
91 Let defs body ->
92 Let <$> defsTransform defs <*> go body
94 GLShader uid src gltipe ->
95 return $ GLShader uid src gltipe
97 PortIn name st ->
98 do portInCheck name st
99 return $ PortIn name st
101 PortOut name st signal ->
102 do portOutCheck name st
103 PortOut name st <$> go signal