git.iko.soy/elk
on edfca84 help sign in
elk/src/Transform/Expression.hs
108 lines 2.9 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2module Transform.Expression (crawlLet, checkWires) 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)
11crawlLet
12 :: ([def] -> Either a [def'])
13 -> Expr ann def var
14 -> Either a (Expr ann def' var)
15crawlLet =
16 crawl (\_ _ -> return ()) (\_ _ -> return ())
19checkWires
20 :: (String -> CanonicalType -> Either a ())
21 -> (String -> CanonicalType -> Either a ())
22 -> Canonical.Expr
23 -> Either a Canonical.Expr
24checkWires inputCheck outputCheck expr =
25 crawl inputCheck outputCheck (mapM checkDef) expr
26 where
27 checkDef def@(Canonical.Definition _ body _) =
28 do _ <- checkWires inputCheck outputCheck body
29 return def
32crawl
33 :: (String -> Type var -> Either a ())
34 -> (String -> Type var -> Either a ())
35 -> ([def] -> Either a [def'])
36 -> Expr ann def var
37 -> Either a (Expr ann def' var)
38crawl inputCheck outputCheck defsTransform =
39 go
40 where
41 go (A srcSpan expr) =
42 A srcSpan <$>
43 case expr of
44 Var x ->
45 return (Var x)
47 Lambda p e ->
48 Lambda p <$> go e
50 Binop op e1 e2 ->
51 Binop op <$> go e1 <*> go e2
53 Case e cases ->
54 Case <$> go e <*> mapM (\(p,b) -> (,) p <$> go b) cases
56 Data name es ->
57 Data name <$> mapM go es
59 Literal lit ->
60 return (Literal lit)
62 Range e1 e2 ->
63 Range <$> go e1 <*> go e2
65 ExplicitList es ->
66 ExplicitList <$> mapM go es
68 App e1 e2 ->
69 App <$> go e1 <*> go e2
71 MultiIf branches ->
72 MultiIf <$> mapM (\(b,e) -> (,) <$> go b <*> go e) branches
74 Access e lbl ->
75 Access <$> go e <*> return lbl
77 Remove e lbl ->
78 Remove <$> go e <*> return lbl
80 Insert e lbl v ->
81 Insert <$> go e <*> return lbl <*> go v
83 Modify e fields ->
84 Modify <$> go e <*> mapM (\(k,v) -> (,) k <$> go v) fields
86 Record fields ->
87 Record <$> mapM (\(k,v) -> (,) k <$> go v) fields
89 Let defs body ->
90 Let <$> defsTransform defs <*> go body
92 GLShader uid src gltipe ->
93 return $ GLShader uid src gltipe
95 Input name st ->
96 do inputCheck name st
97 return $ Input name st
99 Output name st signal ->
100 do outputCheck name st
101 Output name st <$> go signal
103 Loopback name st maybeExpr ->
104 case maybeExpr of
105 Nothing ->
106 error "loopback check"
107 Just expr ->
108 error "loopback check"