9dda928 · elk · git.iko.soy

compiler/Generate/JavaScript.hs+4−2

compare with master

unifiedsplit

@@ -197,8 +197,10 @@ expression (L span expr) =

197 md = pad ++ MD.toHtml doc ++ pad

198

199 PortIn name _ _ handler ->

200+ do handler' <- case handler of

201+ Nothing -> return []

200− do handler' <- expression handler

202+ Just h -> (:[]) `fmap` expression h

201− return $ obj "Native.Ports.portIn" `call` [ string name, handler' ]

203+ return $ obj "Native.Ports.portIn" `call` ([ string name ] ++ handler')

202

204

203 PortOut name _ signal ->

205 PortOut name _ signal ->

204 do signal' <- expression signal

206 do signal' <- expression signal

compiler/SourceSyntax/Declaration.hs+5−2

@@ -29,7 +29,7 @@ data ParsePort

29

30data Port

31 = Out String Expr.LExpr T.Type

32− | In String Expr.LExpr T.Type

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

33 deriving (Show)

34

35type ParseDeclaration = Declaration' ParsePort Expr.ParseDef

@@ -108,7 +108,10 @@ instance Pretty Port where

108 pretty port =

109 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

111− In name expr tipe -> mkPort "->" name expr tipe

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

112 where

115 where

113 mkPort arrow name expr tipe =

116 mkPort arrow name expr tipe =

114 P.vcat [ prettyPort name ":" tipe

117 P.vcat [ prettyPort name ":" tipe

compiler/SourceSyntax/Expression.hs+2−2

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

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

41 | Markdown String String [LExpr' def]

42 -- for type checking and code gen only

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

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

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

45

46type ParseExpr = Expr' ParseDef

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

129

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

131

132− PortIn _ _ _ handler -> pretty handler

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

133

134 PortOut _ _ signal -> pretty signal

135

compiler/Transform/Canonicalize.hs+2−1

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

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

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

6import Control.Monad.Identity

7+import Data.Traversable (traverse)

7import qualified Data.Map as Map

8import qualified Data.Map as Map

8import qualified Data.Set as Set

9import qualified Data.Set as Set

9import qualified Data.List as List

10import qualified Data.List as List

@@ -169,7 +170,7 @@ rename env (L s expr) =

169

170

170 PortIn name st tt handler ->

171 PortIn name st tt handler ->

171 do st' <- renameType' env st

172 do st' <- renameType' env st

172− handler' <- rnm handler

173+ handler' <- traverse rnm handler

173 return $ PortIn name st' tt handler'

174 return $ PortIn name st' tt handler'

174

175

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

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

compiler/Transform/Check.hs+5−3

@@ -1,6 +1,7 @@

1{-# OPTIONS_GHC -Wall #-}

2module Transform.Check (mistakes) where

3

4+import qualified Control.Arrow as Arrow

4import qualified Data.List as List

5import qualified Data.List as List

5import qualified Data.Maybe as Maybe

6import qualified Data.Maybe as Maybe

6import qualified Data.Set as Set

7import qualified Data.Set as Set

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

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

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

45

46

46 (portNames, portExprs) =

47 (portNames, portExprs) =

48+ Arrow.second Maybe.catMaybes $ unzip $

47− unzip $ flip map [ port | D.Port port <- decls ] $ \port ->

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

48 case port of

50 case port of

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

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

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

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

51

53

52 getNames = Set.toList . Pattern.boundVars

54 getNames = Set.toList . Pattern.boundVars

53

55

compiler/Transform/Declaration.hs+3−2

@@ -62,6 +62,7 @@ combineAnnotations = go

62

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

64 do expr' <- exprCombineAnnotations expr

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

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

66+

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

66

68

67− _ -> Left (msg name)

compiler/Transform/Expression.hs+2−1

@@ -2,6 +2,7 @@

2module Transform.Expression (crawlLet, checkPorts) where

3

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

5+import Data.Traversable (traverse)

5import SourceSyntax.Expression

6import SourceSyntax.Expression

6import SourceSyntax.Location

7import SourceSyntax.Location

7import qualified SourceSyntax.Type as ST

8import qualified SourceSyntax.Type as ST

@@ -50,7 +51,7 @@ crawl portInCheck portOutCheck defsTransform = go

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

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

51 PortIn name st tt handler ->

52 PortIn name st tt handler ->

52 do portInCheck name st tt

53 do portInCheck name st tt

53− PortIn name st tt <$> go handler

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

54 PortOut name st signal ->

55 PortOut name st signal ->

55 do portOutCheck name st

56 do portOutCheck name st

56 PortOut name st <$> go signal

57 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 (f handler)

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

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

54

55definition :: Def -> Def

compiler/Transform/SortDefinitions.hs+3−1

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

3

4import Control.Monad.State

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

6+import Data.Traversable (traverse)

6import qualified Data.Map as Map

7import qualified Data.Map as Map

7import SourceSyntax.Expression

8import SourceSyntax.Expression

8import SourceSyntax.Location

9import SourceSyntax.Location

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

85

86

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

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

87

88

89+ PortIn name st tt handler ->

88− PortIn name st tt handler -> PortIn name st tt <$> reorder handler

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

89

91

90 -- Actually do some reordering

92 -- Actually do some reordering

91 Let defs body ->

93 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 (f handler)

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

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

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

@@ -49,10 +49,14 @@ toDefs decl =

49 case port of

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

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

52− In name expr@(L.L s _) tipe ->

52+ In name mexpr tipe ->

53 unsafePerformIO $ do

54 tvar <- Type.var Type.Flexible

55− return $ [ definition name (L.L s $ E.PortIn name tipe tvar expr) tipe ]

55+ return $ [ definition name (loc $ E.PortIn name tipe tvar mexpr) tipe ]

56+ where

57+ loc = case mexpr of

58+ Just (L.L s _) -> L.L s

59+ Nothing -> L.none

56

60

57 -- no constraints are needed for fixity declarations

61 -- no constraints are needed for fixity declarations

58 Fixity _ _ _ -> []

62 Fixity _ _ _ -> []

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

@@ -3,6 +3,7 @@ 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

6import qualified Data.Set as Set

7import qualified Data.Set as Set

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

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

8import qualified Control.Monad as Monad

9import qualified Control.Monad as Monad

@@ -147,7 +148,9 @@ constrain env (L span expr) tipe =

147 (c1 /\ c))

148 (c1 /\ c))

148

149

149 PortIn _ _ tt handler ->

150 PortIn _ _ tt handler ->

150− constrain env handler (VarN tt)

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

152+ where

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

151

154

152 PortOut _ _ signal ->

155 PortOut _ _ signal ->

153 constrain env signal tipe

156 constrain env signal tipe