git.iko.soy/elk
on 63243ca help sign in
elk/compiler/Transform/Expression.hs
55 lines 2.3 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
9crawlLet :: ([def] -> Either a [def']) -> LExpr' def -> Either a (LExpr' def')
10crawlLet = crawl (\_ _ -> return ()) (\_ _ -> return ())
12checkPorts :: (String -> ST.Type -> Either a ())
13 -> (String -> ST.Type -> Either a ())
14 -> LExpr
15 -> Either a LExpr
16checkPorts inCheck outCheck expr =
17 crawl inCheck outCheck (mapM checkDef) expr
18 where
19 checkDef def@(Definition _ body _) =
20 do _ <- checkPorts inCheck outCheck body
21 return def
23crawl :: (String -> ST.Type -> Either a ())
24 -> (String -> ST.Type -> Either a ())
25 -> ([def] -> Either a [def'])
26 -> LExpr' def
27 -> Either a (LExpr' def')
28crawl portInCheck portOutCheck defsTransform = go
29 where
30 go (L srcSpan expr) =
31 L srcSpan <$>
32 case expr of
33 Var x -> return (Var x)
34 Lambda p e -> Lambda p <$> go e
35 Binop op e1 e2 -> Binop op <$> go e1 <*> go e2
36 Case e cases -> Case <$> go e <*> mapM (\(p,b) -> (,) p <$> go b) cases
37 Data name es -> Data name <$> mapM go es
38 Literal lit -> return (Literal lit)
39 Range e1 e2 -> Range <$> go e1 <*> go e2
40 ExplicitList es -> ExplicitList <$> mapM go es
41 App e1 e2 -> App <$> go e1 <*> go e2
42 MultiIf branches -> MultiIf <$> mapM (\(b,e) -> (,) <$> go b <*> go e) branches
43 Access e lbl -> Access <$> go e <*> return lbl
44 Remove e lbl -> Remove <$> go e <*> return lbl
45 Insert e lbl v -> Insert <$> go e <*> return lbl <*> go v
46 Modify e fields -> Modify <$> go e <*> mapM (\(k,v) -> (,) k <$> go v) fields
47 Record fields -> Record <$> mapM (\(k,v) -> (,) k <$> go v) fields
48 Markdown uid md es -> Markdown uid md <$> mapM go es
49 Let defs body -> Let <$> defsTransform defs <*> go body
50 PortIn name st ->
51 do portInCheck name st
52 return $ PortIn name st
53 PortOut name st signal ->
54 do portOutCheck name st
55 PortOut name st <$> go signal