329077f · elk · git.iko.soy

compiler/Parse/Declaration.hs+2−3

compare with master

unifiedsplit

@@ -59,6 +59,5 @@ port =

59 name <- lowVar

60 whitespace

61 let port' op ctor expr = do { try op ; whitespace ; ctor name <$> expr }

62− D.Port <$> choice [ port' hasType D.PPAnnotation Type.expr

62+ D.Port <$> choice [ port' hasType D.PPAnnotation Type.expr

63− , port' (string "<-") D.PPOut Expr.expr

63+ , port' equals D.PPDef Expr.expr ]

64− , port' (string "->") D.PPIn Expr.expr ]

compiler/SourceSyntax/Declaration.hs+7−14

@@ -23,13 +23,12 @@ data Derivation = Json | JS | Binary | New

23

24data ParsePort

25 = PPAnnotation String T.Type

26− | PPOut String Expr.LParseExpr

27− | PPIn String Expr.LParseExpr

26+ | PPDef String Expr.LParseExpr

28 deriving (Show)

27 deriving (Show)

29

28

30data Port

29data Port

31 = Out String Expr.LExpr T.Type

30 = Out String Expr.LExpr T.Type

32− | In String (Maybe Expr.LExpr) T.Type

31+ | In String T.Type

33 deriving (Show)

32 deriving (Show)

34

33

35type ParseDeclaration = Declaration' ParsePort Expr.ParseDef

34type ParseDeclaration = Declaration' ParsePort Expr.ParseDef

@@ -101,21 +100,15 @@ instance Pretty ParsePort where

101 pretty port =

100 pretty port =

102 case port of

101 case port of

103 PPAnnotation name tipe -> prettyPort name ":" tipe

102 PPAnnotation name tipe -> prettyPort name ":" tipe

104− PPOut name expr -> prettyPort name "<-" expr

105− PPIn name expr -> prettyPort name "->" expr

103+ PPDef name expr -> prettyPort name "=" expr

106

104

107instance Pretty Port where

105instance Pretty Port where

108 pretty port =

106 pretty port =

109 case port of

107 case port of

110− Out name expr tipe -> mkPort "<-" name expr tipe

111− In name mexpr tipe ->

112− case mexpr of

113− Nothing -> prettyPort name ":" tipe

108+ In name tipe -> prettyPort name ":" tipe

114− Just expr -> mkPort "->" name expr tipe

115− where

116− mkPort arrow name expr tipe =

117− P.vcat [ prettyPort name ":" tipe

109+ Out name expr tipe -> P.vcat [ prettyPort name ":" tipe

118− , prettyPort name arrow expr ]

110+ , prettyPort name "=" expr ]

111+

119

112

120prettyPort :: (Pretty a) => String -> String -> a -> Doc

113prettyPort :: (Pretty a) => String -> String -> a -> Doc

121prettyPort name op e = P.text "port" <+> P.text name <+> P.text op <+> pretty e

114prettyPort name op e = P.text "port" <+> P.text name <+> P.text op <+> pretty e

compiler/SourceSyntax/Expression.hs+2−3

@@ -8,7 +8,6 @@ import qualified SourceSyntax.Location as Location

8import qualified SourceSyntax.Pattern as Pattern

9import qualified SourceSyntax.Type as SrcType

10import qualified SourceSyntax.Literal as Literal

11−import qualified Type.Type as Type

12

11

13{-| This is a located expression. -}

12{-| This is a located expression. -}

14type LExpr' def = Location.Located (Expr' def)

13type LExpr' def = Location.Located (Expr' def)

@@ -40,7 +39,7 @@ data Expr' def

40 | Record [(String, LExpr' def)]

39 | Record [(String, LExpr' def)]

41 | Markdown String String [LExpr' def]

40 | Markdown String String [LExpr' def]

42 -- for type checking and code gen only

41 -- for type checking and code gen only

43− | PortIn String SrcType.Type Type.Variable (Maybe (LExpr' def))

42+ | PortIn String SrcType.Type

44 | PortOut String SrcType.Type (LExpr' def)

43 | PortOut String SrcType.Type (LExpr' def)

45

44

46type ParseExpr = Expr' ParseDef

45type ParseExpr = Expr' ParseDef

@@ -129,7 +128,7 @@ instance Pretty def => Pretty (Expr' def) where

129

128

130 Markdown _ _ _ -> P.text "[markdown| ... |]"

129 Markdown _ _ _ -> P.text "[markdown| ... |]"

131

130

132− PortIn _ _ _ _ -> P.text "<port in>"

131+ PortIn name _ -> P.text $ "<port:" ++ name ++ ">"

133

132

134 PortOut _ _ signal -> pretty signal

133 PortOut _ _ signal -> pretty signal

135

134

compiler/Transform/Canonicalize.hs+1−5

@@ -4,7 +4,6 @@ module Transform.Canonicalize (interface, metadataModule) where

4import Control.Arrow ((***))

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

6import Control.Monad.Identity

7−import Data.Traversable (traverse)

8import qualified Data.Map as Map

7import qualified Data.Map as Map

9import qualified Data.Set as Set

8import qualified Data.Set as Set

10import qualified Data.List as List

9import qualified Data.List as List

@@ -167,10 +166,7 @@ rename env (L s expr) =

167

166

168 Markdown uid md es -> Markdown uid md <$> mapM rnm es

167 Markdown uid md es -> Markdown uid md <$> mapM rnm es

169

168

170− PortIn name st tt handler ->

171− do st' <- renameType' env st

169+ PortIn name st -> PortIn name <$> renameType' env st

172− handler' <- traverse rnm handler

173− return $ PortIn name st' tt handler'

174

170

175 PortOut name st signal -> PortOut name <$> renameType' env st <*> rnm signal

171 PortOut name st signal -> PortOut name <$> renameType' env st <*> rnm signal

176

172

compiler/Transform/Check.hs+3−3

@@ -45,11 +45,11 @@ duplicates decls =

45 unzip [ (pat,expr) | D.Definition (E.Definition pat expr _) <- decls ]

46

47 (portNames, portExprs) =

48− Arrow.second Maybe.catMaybes $ unzip $

48+ Arrow.second concat $ unzip $

49 flip map [ port | D.Port port <- decls ] $ \port ->

50 case port of

51− D.Out name expr _ -> (name, Just expr)

51+ D.Out name expr _ -> (name, [expr])

52− D.In name expr _ -> (name, expr)

52+ D.In name _ -> (name, [])

53

54 getNames = Set.toList . Pattern.boundVars

55

compiler/Transform/Declaration.hs+3−8

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

52 -- combine ports

53 Port port : portRest ->

54 case port of

55− PPOut name _ -> Left (msg name)

56− PPIn name _ -> Left (msg name)

55+ PPDef name _ -> Left (msg name)

57 PPAnnotation name tipe ->

56 PPAnnotation name tipe ->

58 case portRest of

57 case portRest of

59− Port (PPOut name' expr) : rest | name == name' ->

58+ Port (PPDef name' expr) : rest | name == name' ->

60 do expr' <- exprCombineAnnotations expr

59 do expr' <- exprCombineAnnotations expr

61 (:) (Port (Out name expr' tipe)) <$> go rest

60 (:) (Port (Out name expr' tipe)) <$> go rest

62

61

63− Port (PPIn name' expr) : rest | name == name' ->

64− do expr' <- exprCombineAnnotations expr

65− (:) (Port (In name (Just expr') tipe)) <$> go rest

66−

67− _ -> (:) (Port (In name Nothing tipe)) <$> go portRest

62+ _ -> (:) (Port (In name tipe)) <$> go portRest

68

63

compiler/Transform/Expression.hs+6−8

@@ -2,16 +2,14 @@

2module Transform.Expression (crawlLet, checkPorts) where

3

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

5−import Data.Traversable (traverse)

6import SourceSyntax.Expression

5import SourceSyntax.Expression

7import SourceSyntax.Location

6import SourceSyntax.Location

8import qualified SourceSyntax.Type as ST

7import qualified SourceSyntax.Type as ST

9−import qualified Type.Type as TT

10

8

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

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

12−crawlLet = crawl (\_ _ _ -> return ()) (\_ _ -> return ())

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

13

11

14−checkPorts :: (String -> ST.Type -> TT.Variable -> Either a ())

12+checkPorts :: (String -> ST.Type -> Either a ())

15 -> (String -> ST.Type -> Either a ())

13 -> (String -> ST.Type -> Either a ())

16 -> LExpr

14 -> LExpr

17 -> Either a LExpr

15 -> Either a LExpr

@@ -22,7 +20,7 @@ checkPorts inCheck outCheck expr =

22 do _ <- checkPorts inCheck outCheck body

20 do _ <- checkPorts inCheck outCheck body

23 return def

21 return def

24

22

25−crawl :: (String -> ST.Type -> TT.Variable -> Either a ())

23+crawl :: (String -> ST.Type -> Either a ())

26 -> (String -> ST.Type -> Either a ())

24 -> (String -> ST.Type -> Either a ())

27 -> ([def] -> Either a [def'])

25 -> ([def] -> Either a [def'])

28 -> LExpr' def

26 -> LExpr' def

@@ -49,9 +47,9 @@ crawl portInCheck portOutCheck defsTransform = go

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

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

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

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

51 Let defs body -> Let <$> defsTransform defs <*> go body

49 Let defs body -> Let <$> defsTransform defs <*> go body

52− PortIn name st tt handler ->

50+ PortIn name st ->

53− do portInCheck name st tt

51+ do portInCheck name st

54− PortIn name st tt <$> traverse go handler

52+ return $ PortIn name st

55 PortOut name st signal ->

53 PortOut name st signal ->

56 do portOutCheck name st

54 do portOutCheck name st

57 PortOut name st <$> go signal

55 PortOut name st <$> go signal

compiler/Transform/SafeNames.hs+1−1

@@ -49,7 +49,7 @@ expression (L loc expr) =

49 Modify r fs -> Modify (f r) (map (var *** f) fs)

50 Record fs -> Record (map (var *** f) fs)

51 Markdown uid md es -> Markdown uid md (map f es)

52− PortIn name st tt handler -> PortIn name st tt (fmap f handler)

52+ PortIn name st -> PortIn name st

53 PortOut name st signal -> PortOut name st (f signal)

54

55definition :: Def -> Def

compiler/Transform/SortDefinitions.hs+1−3

@@ -3,7 +3,6 @@ module Transform.SortDefinitions (sortDefs) where

3

4import Control.Monad.State

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

6−import Data.Traversable (traverse)

7import qualified Data.Map as Map

6import qualified Data.Map as Map

8import SourceSyntax.Expression

7import SourceSyntax.Expression

9import SourceSyntax.Location

8import SourceSyntax.Location

@@ -86,8 +85,7 @@ reorder (L s expr) =

86

85

87 PortOut name st signal -> PortOut name st <$> reorder signal

86 PortOut name st signal -> PortOut name st <$> reorder signal

88

87

89− PortIn name st tt handler ->

88+ PortIn name st -> return $ PortIn name st

90− PortIn name st tt <$> traverse reorder handler

91

89

92 -- Actually do some reordering

90 -- Actually do some reordering

93 Let defs body ->

91 Let defs body ->

compiler/Transform/Substitute.hs+1−1

@@ -38,5 +38,5 @@ subst old new expr =

38 Record fs -> Record (map (second f) fs)

39 Literal _ -> expr

40 Markdown uid md es -> Markdown uid md (map f es)

41− PortIn name st tt handler -> PortIn name st tt (fmap f handler)

41+ PortIn name st -> PortIn name st

42 PortOut name st signal -> PortOut name st (f signal)

compiler/Type/Constrain/Declaration.hs+2−10

@@ -6,8 +6,6 @@ import qualified SourceSyntax.Expression as E

6import qualified SourceSyntax.Location as L

7import qualified SourceSyntax.Pattern as P

8import qualified SourceSyntax.Type as T

9−import qualified Type.Type as Type

10−import System.IO.Unsafe

11

9

12toExpr :: [Declaration] -> [E.Def]

10toExpr :: [Declaration] -> [E.Def]

13toExpr = concatMap toDefs

11toExpr = concatMap toDefs

@@ -47,14 +45,8 @@ toDefs decl =

47 case port of

45 case port of

48 Out name expr@(L.L s _) tipe ->

46 Out name expr@(L.L s _) tipe ->

49 [ definition name (L.L s $ E.PortOut name tipe expr) tipe ]

47 [ definition name (L.L s $ E.PortOut name tipe expr) tipe ]

50− In name mexpr tipe ->

48+ In name tipe ->

51− unsafePerformIO $ do

52− tvar <- Type.var Type.Flexible

53− return $ [ definition name (loc $ E.PortIn name tipe tvar mexpr) tipe ]

49+ [ definition name (L.none $ E.PortIn name tipe) tipe ]

54− where

55− loc = case mexpr of

56− Just (L.L s _) -> L.L s

57− Nothing -> L.none

58

50

59 -- no constraints are needed for fixity declarations

51 -- no constraints are needed for fixity declarations

60 Fixity _ _ _ -> []

52 Fixity _ _ _ -> []

compiler/Type/Constrain/Expression.hs+1−5

@@ -3,7 +3,6 @@ module Type.Constrain.Expression where

3

4import qualified Data.List as List

5import qualified Data.Map as Map

6−import qualified Data.Maybe as Maybe

7import qualified Data.Set as Set

6import qualified Data.Set as Set

8import Control.Applicative ((<$>))

7import Control.Applicative ((<$>))

9import qualified Control.Monad as Monad

8import qualified Control.Monad as Monad

@@ -147,10 +146,7 @@ constrain env (L span expr) tipe =

147 (clet [Scheme rqs fqs (clet [monoscheme header] c2) header ]

146 (clet [Scheme rqs fqs (clet [monoscheme header] c2) header ]

148 (c1 /\ c))

147 (c1 /\ c))

149

148

150− PortIn _ _ tt handler ->

149+ PortIn _ _ -> return true

151− constrain env (Maybe.fromMaybe identity handler) (VarN tt)

152− where

153− identity = Loc.none $ Lambda (PVar "x") (Loc.none $ Var "x")

154

150

155 PortOut _ _ signal ->

151 PortOut _ _ signal ->

156 constrain env signal tipe

152 constrain env signal tipe