5dd7b6b · elk · git.iko.soy

git.iko.soy/elk

Extend expression crawler to do checks on ports as well as on let expressions

commit5dd7b6b1bb318b0401a21213e4803190f10719f8 authorEvan Czaplicki <info@elm-lang.org> dateSun 5 Jan 2014, 10:15 (13 years ago) parent9ea9854

4 files changed+41−13

compare with master

unifiedsplit

compiler/Transform/Check.hs+1−1 compiler/Transform/Declaration.hs+6−4 compiler/Transform/Definition.hs+4−2 compiler/Transform/Expression.hs+30−6

compiler/Transform/Check.hs+1−1

@@ -52,7 +52,7 @@ duplicates decls =

5252 getNames = Set.toList . Pattern.boundVars

5353

5454 exprDups :: E.LExpr -> Either String E.LExpr

55− exprDups expr = Expr.crawl defsDups expr

55+ exprDups expr = Expr.crawlLet defsDups expr

5656

5757 defsDups :: [E.Def] -> Either String [E.Def]

5858 defsDups defs =

compiler/Transform/Declaration.hs+6−4

@@ -16,6 +16,8 @@ combineAnnotations = go

1616 msg x = "Syntax Error: The type annotation for '" ++ x ++

1717 "' must be directly above its definition."

1818

19+ exprCombineAnnotations = Expr.crawlLet Def.combineAnnotations

20+

1921 go decls =

2022 case decls of

2123 -- simple cases, pass them through with no changes

@@ -34,14 +36,14 @@ combineAnnotations = go

3436 D.Definition def : defRest ->

3537 case def of

3638 Def pat expr ->

37− do expr' <- Expr.crawl Def.combineAnnotations expr

39+ do expr' <- exprCombineAnnotations expr

3840 let def' = E.Definition pat expr' Nothing

3941 (:) (D.Definition def') <$> go defRest

4042

4143 TypeAnnotation name tipe ->

4244 case defRest of

4345 D.Definition (Def pat@(P.PVar name') expr) : rest | name == name' ->

44− do expr' <- Expr.crawl Def.combineAnnotations expr

46+ do expr' <- exprCombineAnnotations expr

4547 let def' = E.Definition pat expr' (Just tipe)

4648 (:) (D.Definition def') <$> go rest

4749

@@ -55,11 +57,11 @@ combineAnnotations = go

5557 PortAnnotation name tipe ->

5658 case portRest of

5759 Port (SendDefinition name' expr) : rest | name == name' ->

58− do expr' <- Expr.crawl Def.combineAnnotations expr

60+ do expr' <- exprCombineAnnotations expr

5961 (:) (Port (Send name expr' tipe)) <$> go rest

6062

6163 Port (RecvDefinition name' expr) : rest | name == name' ->

62− do expr' <- Expr.crawl Def.combineAnnotations expr

64+ do expr' <- exprCombineAnnotations expr

6365 (:) (Port (Recv name expr' tipe)) <$> go rest

6466

6567 _ -> Left (msg name)

compiler/Transform/Definition.hs+4−2

@@ -12,17 +12,19 @@ combineAnnotations = go

1212 msg x = "Syntax Error: The type annotation for '" ++ x ++

1313 "' must be directly above its definition."

1414

15+ exprCombineAnnotations = Expr.crawlLet combineAnnotations

16+

1517 go defs =

1618 case defs of

1719 TypeAnnotation name tipe : Def pat@(P.PVar name') expr : rest | name == name' ->

18− do expr' <- Expr.crawl combineAnnotations expr

20+ do expr' <- exprCombineAnnotations expr

1921 let def = Definition pat expr' (Just tipe)

2022 (:) def <$> go rest

2123

2224 TypeAnnotation name _ : _ -> Left (msg name)

2325

2426 Def pat expr : rest ->

25− do expr' <- Expr.crawl combineAnnotations expr

27+ do expr' <- exprCombineAnnotations expr

2628 let def = Definition pat expr' Nothing

2729 (:) def <$> go rest

2830

compiler/Transform/Expression.hs+30−6

@@ -1,12 +1,32 @@

11{-# OPTIONS_GHC -Wall #-}

2−module Transform.Expression where

2+module Transform.Expression (crawlLet, checkPorts) where

44import Control.Applicative ((<$>),(<*>))

55import SourceSyntax.Expression

66import SourceSyntax.Location

7+import qualified SourceSyntax.Type as ST

8+import qualified Type.Type as TT

8−crawl :: ([def] -> Either a [def']) -> (LExpr' def) -> Either a (LExpr' def')

9−crawl transform = go

10+crawlLet :: ([def] -> Either a [def']) -> LExpr' def -> Either a (LExpr' def')

11+crawlLet = crawl (\_ _ _ -> return ()) (\_ _ -> return ())

12+

13+checkPorts :: (String -> ST.Type -> TT.Variable -> Either a ())

14+ -> (String -> ST.Type -> Either a ())

15+ -> LExpr

16+ -> Either a LExpr

17+checkPorts 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

23+

24+crawl :: (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')

29+crawl portInCheck portOutCheck defsTransform = go

1030 where

1131 go (L srcSpan expr) =

1232 L srcSpan <$>

@@ -27,6 +47,10 @@ crawl transform = go

2747 Modify e fields -> Modify <$> go e <*> mapM (\(k,v) -> (,) k <$> go v) fields

2848 Record fields -> Record <$> mapM (\(k,v) -> (,) k <$> go v) fields

2949 Markdown uid md es -> Markdown uid md <$> mapM go es

30− Let defs body -> Let <$> transform defs <*> go body

31− PortIn name st tt handler -> PortIn name st tt <$> go handler

32− PortOut name st signal -> PortOut name st <$> go signal

50+ Let defs body -> Let <$> defsTransform defs <*> go body

51+ PortIn name st tt handler ->

52+ do portInCheck name st tt

53+ PortIn name st tt <$> go handler

54+ PortOut name st signal ->

55+ do portOutCheck name st

56+ PortOut name st <$> go signal