0d83d8d · elk · git.iko.soy

src/AST/Declaration.hs+55−13

compare with master

unifiedsplit

@@ -13,12 +13,11 @@ import Text.PrettyPrint as P

13

14-- DECLARATIONS

15

16−data Declaration' portType def var expr

16+data Declaration' port def var expr

17 = Definition def

18 | Datatype String [String] [(String, [T.Type var])]

19 | TypeAlias String [String] (T.Type var)

20− | Port String portType

20+ | Port port

21− | Perform Int expr

22 | Fixity Assoc Int String

21 | Fixity Assoc Int String

23

22

24

23

@@ -29,15 +28,38 @@ data Assoc = L | N | R

29-- DECLARATION PHASES

28-- DECLARATION PHASES

30

29

31type SourceDecl =

30type SourceDecl =

32− Declaration' T.RawType Source.Def Var.Raw Source.Expr

31+ Declaration' RawPort Source.Def Var.Raw Source.Expr

33

32

34

33

35type ValidDecl =

34type ValidDecl =

36− Declaration' T.RawType Valid.Def Var.Raw Valid.Expr

35+ Declaration' (Port Valid.Expr T.RawType) Valid.Def Var.Raw Valid.Expr

37

36

38

37

39type CanonicalDecl =

38type CanonicalDecl =

40− Declaration' (T.PortType Var.Canonical) Canonical.Def Var.Canonical Canonical.Expr

39+ Declaration' CanonicalPort Canonical.Def Var.Canonical Canonical.Expr

40+

41+

42+-- PORTS

43+

44+data RawPort

45+ = PortAnnotation String T.RawType

46+ | PortDefinition String Source.Expr

47+

48+

49+data Port expr tipe

50+ = Inbound String tipe

51+ | Outbound String expr tipe

52+

53+

54+type CanonicalPort =

55+ Port Canonical.Expr (T.PortType Var.Canonical)

56+

57+

58+getName :: Port expr tipe -> String

59+getName port =

60+ case port of

61+ Inbound name _ -> name

62+ Outbound name _ _ -> name

41

63

42

64

43-- BINARY CONVERSION

65-- BINARY CONVERSION

@@ -69,8 +91,8 @@ assocToString assoc =

69 R -> "right"

91 R -> "right"

70

92

71

93

72−instance (Pretty portType, Pretty def, Pretty var, Var.ToString var, Pretty expr) =>

94+instance (Pretty port, Pretty def, Pretty var, Var.ToString var, Pretty expr) =>

73− Pretty (Declaration' portType def var expr) where

95+ Pretty (Declaration' port def var expr) where

74 pretty decl =

96 pretty decl =

75 case decl of

97 case decl of

76 Definition def -> pretty def

98 Definition def -> pretty def

@@ -96,11 +118,8 @@ instance (Pretty portType, Pretty def, Pretty var, Var.ToString var, Pretty expr

96 name' =

118 name' =

97 P.text name <+> P.hsep (map P.text tvars)

119 P.text name <+> P.hsep (map P.text tvars)

98

120

99− Port name tipe ->

121+ Port port ->

100− P.text "port" <+> P.text name <+> P.colon <+> pretty tipe

122+ pretty port

101−

102− Perform _ expr ->

103− P.text "perform" <+> pretty expr

104

123

105 Fixity assoc prec op ->

124 Fixity assoc prec op ->

106 P.text "infix" <> assoc' <+> P.int prec <+> P.text op

125 P.text "infix" <> assoc' <+> P.int prec <+> P.text op

@@ -110,3 +129,26 @@ instance (Pretty portType, Pretty def, Pretty var, Var.ToString var, Pretty expr

110 L -> P.text "l"

129 L -> P.text "l"

111 N -> P.empty

130 N -> P.empty

112 R -> P.text "r"

131 R -> P.text "r"

132+

133+

134+instance Pretty RawPort where

135+ pretty port =

136+ case port of

137+ PortAnnotation name tipe ->

138+ P.text "port" <+> P.text name <+> P.colon <+> pretty tipe

139+

140+ PortDefinition name expr ->

141+ P.text "port" <+> P.text name <+> P.equals <+> pretty expr

142+

143+

144+instance (Pretty expr, Pretty tipe) => Pretty (Port expr tipe) where

145+ pretty port =

146+ case port of

147+ Inbound name tipe ->

148+ P.text "port" <+> P.text name <+> P.colon <+> pretty tipe

149+

150+ Outbound name expr tipe ->

151+ P.vcat

152+ [ P.text "port" <+> P.text name <+> P.colon <+> pretty tipe

153+ , P.hang (P.text "port" <+> P.text name <+> P.equals) 4 (pretty expr)

154+ ]

src/AST/Expression/General.hs+8−6

@@ -10,12 +10,12 @@ module AST.Expression.General where

10

11import AST.PrettyPrint

12import Text.PrettyPrint as P

13−import AST.Type (PortDirection)

14

13

15import qualified AST.Annotation as Annotation

14import qualified AST.Annotation as Annotation

16import qualified AST.Helpers as Help

15import qualified AST.Helpers as Help

17import qualified AST.Literal as Literal

16import qualified AST.Literal as Literal

18import qualified AST.Pattern as Pattern

17import qualified AST.Pattern as Pattern

18+import qualified AST.Type as Type

19import qualified AST.Variable as Var

20

21

@@ -58,12 +58,17 @@ data Expr' ann def var

58 | Modify (Expr ann def var) [(String, Expr ann def var)]

59 | Record [(String, Expr ann def var)]

60 -- for type checking and code gen only

61− | Port String (PortDirection var)

62− | Perform (Expr ann def var)

61+ | Port String (PortImpl (Expr ann def var) var)

63 | GLShader String String Literal.GLShaderTipe

62 | GLShader String String Literal.GLShaderTipe

64 deriving (Show)

63 deriving (Show)

65

64

66

65

66+data PortImpl expr var

67+ = Inbound (Type.PortType var)

68+ | Outbound (Type.PortType var) expr

69+ deriving (Show)

70+

71+

67---- UTILITIES ----

72---- UTILITIES ----

68

73

69rawVar :: String -> Expr' ann def Var.Raw

74rawVar :: String -> Expr' ann def Var.Raw

@@ -198,9 +203,6 @@ instance (Pretty def, Pretty var, Var.ToString var) => Pretty (Expr' ann def var

198 Port name _ ->

203 Port name _ ->

199 P.text ("<port:" ++ name ++ ">")

204 P.text ("<port:" ++ name ++ ">")

200

205

201− Perform expr ->

202− P.text "perform" <+> pretty expr

203−

204

206

205collectApps :: Expr ann def var -> [Expr ann def var]

207collectApps :: Expr ann def var -> [Expr ann def var]

206collectApps annExpr@(Annotation.A _ expr) =

208collectApps annExpr@(Annotation.A _ expr) =

src/AST/Type.hs+15−11

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

1module AST.Type

2 ( Type(..), AliasType(..)

3 , RawType, CanonicalType

4− , PortType(..), PortDirection(..)

4+ , PortType(..), portType

5 , fieldMap, recordOf, listOf, tupleOf

6 , deepDealias, dealias

7 , collectLambdas

@@ -45,18 +45,17 @@ type CanonicalType =

45 Type Var.Canonical

46

47

48−data PortType var = PortType

48+data PortType var

49− { direction :: PortDirection var

49+ = Normal (Type var)

50− , tipe :: Type var

50+ | Stream { root :: Type var, arg :: Type var }

51− }

52 deriving (Show)

51 deriving (Show)

53

52

54

53

55−data PortDirection var

54+portType :: PortType var -> Type var

56− = Inbound (Type var)

55+portType portType =

57− | Internal

56+ case portType of

58− | Outbound (Type var)

57+ Normal tipe -> tipe

59− deriving (Show)

58+ Stream tipe _ -> tipe

60

59

61

60

62fieldMap :: [(String,a)] -> Map.Map String [a]

61fieldMap :: [(String,a)] -> Map.Map String [a]

@@ -146,7 +145,12 @@ dealiasHelp typeTable tipe =

146

145

147instance (Pretty var, Var.ToString var) => Pretty (PortType var) where

146instance (Pretty var, Var.ToString var) => Pretty (PortType var) where

148 pretty portType =

147 pretty portType =

149− pretty (tipe portType)

148+ case portType of

149+ Normal tipe ->

150+ pretty tipe

151+

152+ Stream tipe _ ->

153+ pretty tipe

150

154

151

155

152instance (Var.ToString var, Pretty var) => Pretty (Type var) where

156instance (Var.ToString var, Pretty var) => Pretty (Type var) where

src/AST/Variable.hs+8−3

@@ -61,9 +61,9 @@ is home name var =

61 var == Canonical (Module home) name

62

63

64−isJson :: Canonical -> Bool

64+isJavaScript :: Canonical -> Bool

65−isJson =

65+isJavaScript =

66− is ["Json", "Encode"] "Value"

66+ is ["JavaScript", "Encode"] "Value"

67

68

69isMaybe :: Canonical -> Bool

@@ -80,6 +80,11 @@ isTask =

80 is ["Task"] "Task"

81

82

83+isStream :: Canonical -> Bool

84+isStream =

85+ is ["SignalTypes"] "Stream"

86+

87+

83isList :: Canonical -> Bool

88isList :: Canonical -> Bool

84isList v =

89isList v =

85 v == Canonical BuiltIn "List"

90 v == Canonical BuiltIn "List"

src/Docs.hs+1−4

@@ -213,12 +213,9 @@ collectInfo (comment, decl) info =

213 in

214 info { infixes = Map.insert name infixInfo (infixes info) }

215

216− Decl.Port _ _ ->

216+ Decl.Port _ ->

217 error (errorMessage "ports")

218

219− Decl.Perform _ _ ->

220− error (errorMessage "perform declarations")

221−

222

219

223errorMessage :: String -> String

220errorMessage :: String -> String

224errorMessage name =

221errorMessage name =

src/Generate/JavaScript.hs+13−12

@@ -18,11 +18,11 @@ import AST.Annotation

18import AST.Module

19import AST.Expression.General

20import qualified AST.Expression.Canonical as Canonical

21−import qualified AST.Module as Module

22import qualified AST.Helpers as Help

21import qualified AST.Helpers as Help

23import AST.Literal

22import AST.Literal

23+import qualified AST.Module as Module

24import qualified AST.Pattern as P

25−import qualified AST.Type as T

25+import qualified AST.Type as Type

26import qualified AST.Variable as Var

27

28

@@ -207,20 +207,21 @@ expression (A region expr) =

207 GLShader _uid src _tipe ->

208 return $ ObjectLit () [(PropString () "src", literal (Str src))]

209

210− Port name portType ->

210+ Port name impl ->

211− case portType of

211+ case impl of

212− T.Inbound tipe ->

212+ Inbound (Type.Normal tipe) ->

213 return (Port.inbound name tipe)

214

215− T.Internal ->

215+ Inbound (Type.Stream _ tipe) ->

216− return (Port.internal name)

216+ return (Port.inboundStream name tipe)

217

218− T.Outbound tipe ->

218+ Outbound (Type.Normal tipe) expr ->

219+ do expr' <- expression expr

219− return (Port.outbound name tipe)

220+ return (Port.outbound name tipe expr')

220

221

221− Perform expr ->

222+ Outbound (Type.Stream _ tipe) expr ->

222− do expr' <- expression expr

223+ do expr' <- expression expr

223− return (useLazy ["Elm","Native","Task"] "perform" <| expr')

224+ return (Port.outboundStream name tipe expr')

224

225

226

226definition :: Canonical.Def -> State Int [Statement ()]

227definition :: Canonical.Def -> State Int [Statement ()]

src/Generate/JavaScript/Port.hs+31−20

@@ -1,11 +1,15 @@

1−module Generate.JavaScript.Port (inbound, internal, outbound) where

1+module Generate.JavaScript.Port

2+ ( inbound, inboundStream

3+ , outbound, outboundStream

4+ ) where

2

5

3import qualified Data.List as List

6import qualified Data.List as List

4−import Generate.JavaScript.Helpers

7+import Language.ECMAScript3.Syntax

8+

5import AST.PrettyPrint (pretty)

9import AST.PrettyPrint (pretty)

6import AST.Type as T

10import AST.Type as T

7import qualified AST.Variable as Var

11import qualified AST.Variable as Var

8−import Language.ECMAScript3.Syntax

12+import Generate.JavaScript.Helpers

9

13

10

14

11data JSType

15data JSType

@@ -67,22 +71,24 @@ check x jsType continue =

67 [jsFold OpLAnd (typeof "object" : map member fields)]

71 [jsFold OpLAnd (typeof "object" : map member fields)]

68

72

69

73

70−-- INTERNAL

71−

72−internal :: String -> Expression ()

73−internal name =

74− _Port "port" `call` [ string name ]

75−

76−

77-- INBOUND

74-- INBOUND

78

75

79inbound :: String -> CanonicalType -> Expression ()

76inbound :: String -> CanonicalType -> Expression ()

80inbound name tipe =

77inbound name tipe =

81− _Port "inbound" `call`

78+ _Port "inbound" `call`

79+ [ string name

80+ , string (show (pretty tipe))

81+ , toTypeFunction tipe

82+ ]

83+

84+

85+inboundStream :: String -> CanonicalType -> Expression ()

86+inboundStream name tipe =

87+ _Port "inboundStream" `call`

82− [ string name

88+ [ string name

83− , string (show (pretty tipe))

89+ , string (show (pretty tipe))

84− , toTypeFunction tipe

90+ , toTypeFunction tipe

85− ]

91+ ]

86

92

87

93

88toTypeFunction :: CanonicalType -> Expression ()

94toTypeFunction :: CanonicalType -> Expression ()

@@ -111,7 +117,7 @@ toType tipe x =

111 from checks = check x checks x

117 from checks = check x checks x

112

118

113 Type name

119 Type name

114− | Var.isJson name ->

120+ | Var.isJavaScript name ->

115 x

121 x

116

122

117 | Var.isTuple name ->

123 | Var.isTuple name ->

@@ -172,9 +178,14 @@ toTuple types x =

172

178

173-- OUTBOUND

179-- OUTBOUND

174

180

175−outbound :: String -> CanonicalType -> Expression ()

181+outbound :: String -> CanonicalType -> Expression () -> Expression ()

176−outbound name tipe =

182+outbound name tipe expr =

177− _Port "outbound" `call` [ string name, fromTypeFunction tipe ]

183+ _Port "outbound" `call` [ string name, fromTypeFunction tipe, expr ]

184+

185+

186+outboundStream :: String -> CanonicalType -> Expression () -> Expression ()

187+outboundStream name tipe expr =

188+ _Port "outboundStream" `call` [ string name, fromTypeFunction tipe, expr ]

178

189

179

190

180fromTypeFunction :: CanonicalType -> Expression ()

191fromTypeFunction :: CanonicalType -> Expression ()

@@ -212,7 +223,7 @@ fromType tipe x =

212 x

223 x

213

224

214 Type name

225 Type name

215− | Var.isJson name -> x

226+ | Var.isJavaScript name -> x

216 | Var.isTuple name -> ArrayLit () []

227 | Var.isTuple name -> ArrayLit () []

217 | otherwise -> error "bad type got to an output"

228 | otherwise -> error "bad type got to an output"

218

229

src/Parse/Declaration.hs+15−15

@@ -2,10 +2,7 @@

2module Parse.Declaration where

3

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

5−import Text.Parsec

6− ( (<|>), (<?>), choice, digit, getPosition

7− , optionMaybe, sourceLine, string, try

5+import Text.Parsec ( (<|>), (<?>), choice, digit, optionMaybe, string, try )

8− )

9

6

10import qualified AST.Declaration as D

7import qualified AST.Declaration as D

11import qualified Parse.Expression as Expr

8import qualified Parse.Expression as Expr

@@ -15,7 +12,7 @@ import qualified Parse.Type as Type

15

12

16declaration :: IParser D.SourceDecl

13declaration :: IParser D.SourceDecl

17declaration =

14declaration =

18− typeDecl <|> infixDecl <|> port <|> perform <|> definition

15+ typeDecl <|> infixDecl <|> port <|> definition

19

16

20

17

21definition :: IParser D.SourceDecl

18definition :: IParser D.SourceDecl

@@ -62,15 +59,18 @@ port =

62 do try (reserved "port")

59 do try (reserved "port")

63 whitespace

60 whitespace

64 name <- lowVar

61 name <- lowVar

65− padded hasType

66− tipe <- Type.expr <?> "a type"

67− return (D.Port name tipe)

68−

69−

70−perform :: IParser D.SourceDecl

71−perform =

72− do try (reserved "perform")

73− line <- sourceLine <$> getPosition

74 whitespace

62 whitespace

63+ choice [ portAnnotation name, portDefinition name ]

64+ where

65+ portAnnotation name =

66+ do try hasType

67+ whitespace

68+ tipe <- Type.expr <?> "a type"

69+ return (D.Port (D.PortAnnotation name tipe))

70+

71+ portDefinition name =

72+ do try equals

73+ whitespace

75− D.Perform line <$> Expr.expr

74+ expr <- Expr.expr

75+ return (D.Port (D.PortDefinition name expr))

76

src/Transform/Canonicalize.hs+28−21

@@ -9,6 +9,7 @@ import qualified Data.Set as Set

9import qualified Data.Traversable as T

10

11import AST.Expression.General (Expr'(..), dummyLet)

12+import qualified AST.Expression.General as E

12import qualified AST.Expression.Valid as Valid

13import qualified AST.Expression.Valid as Valid

13import qualified AST.Expression.Canonical as Canonical

14import qualified AST.Expression.Canonical as Canonical

14

15

@@ -77,7 +78,7 @@ moduleHelp interfaces modul@(Module.Module _ _ exports _ decls) =

77 , aliases =

78 , aliases =

78 Map.fromList [ (name,(tvs,alias)) | D.TypeAlias name tvs alias <- decls ]

79 Map.fromList [ (name,(tvs,alias)) | D.TypeAlias name tvs alias <- decls ]

79 , ports =

80 , ports =

80− [ name | D.Port name _ <- decls ]

81+ [ D.getName port | D.Port port <- decls ]

81 }

82 }

82

83

84

@@ -202,17 +203,21 @@ declaration env decl =

202 do expanded' <- canonicalize Canonicalize.tipe "type alias" name env expanded

203 do expanded' <- canonicalize Canonicalize.tipe "type alias" name env expanded

203 return (D.TypeAlias name tvars expanded')

204 return (D.TypeAlias name tvars expanded')

204

205

205− D.Port name tipe ->

206+ D.Port port ->

206 do Env.uses ["Native","Port"]

207 do Env.uses ["Native","Port"]

207 Env.uses ["Native","JavaScript"]

208 Env.uses ["Native","JavaScript"]

209+ case port of

210+ D.Inbound name tipe ->

208− tipe' <- canonicalize Canonicalize.tipe "port" name env tipe

211+ do tipe' <- canonicalize Canonicalize.tipe "port" name env tipe

209− portDirection <- Port.check name tipe'

212+ port' <- Port.check name Nothing tipe'

210− return $ D.Port name (Type.PortType portDirection tipe')

213+ return (D.Port port')

211

214

212− D.Perform line expr ->

215+

213− do Env.uses ["Native","Task"]

216+ D.Outbound name expr tipe ->

214− expr' <- expression env expr

217+ do expr' <- expression env expr

215− return $ D.Perform line expr'

218+ tipe' <- canonicalize Canonicalize.tipe "port" name env tipe

219+ port' <- Port.check name (Just expr') tipe'

220+ return (D.Port port')

216

221

217 D.Fixity assoc prec op ->

222 D.Fixity assoc prec op ->

218 return $ D.Fixity assoc prec op

223 return $ D.Fixity assoc prec op

@@ -304,20 +309,22 @@ expression env (A.A ann validExpr) =

304 (,) <$> format (pattern env p)

309 (,) <$> format (pattern env p)

305 <*> expression (Env.addPattern p env) b

310 <*> expression (Env.addPattern p env) b

306

311

307− Port name direction ->

312+ Port name impl ->

308− Port name <$>

313+ let portType pt =

309− case direction of

314+ case pt of

310− Type.Inbound tipe ->

315+ Type.Normal t ->

311− Type.Inbound <$> tipe' env tipe

316+ Type.Normal <$> tipe' env t

312−

313− Type.Internal ->

314− return Type.Internal

315

317

316− Type.Outbound tipe ->

318+ Type.Stream root arg ->

317− Type.Outbound <$> tipe' env tipe

319+ Type.Stream <$> tipe' env root <*> tipe' env arg

320+ in

321+ Port name <$>

322+ case impl of

323+ E.Inbound pt ->

324+ E.Inbound <$> portType pt

318

325

319− Perform expr ->

326+ E.Outbound pt expr ->

320− Perform <$> go expr

327+ E.Outbound <$> portType pt <*> go expr

321

328

322 GLShader uid src tipe ->

329 GLShader uid src tipe ->

323 return (GLShader uid src tipe)

330 return (GLShader uid src tipe)

src/Transform/Canonicalize/Port.hs+31−31

@@ -4,6 +4,8 @@ import Control.Applicative ((<$>))

4import Control.Monad.Error (throwError)

5import Text.PrettyPrint as P

6

7+import qualified AST.Declaration as D

8+import qualified AST.Expression.Canonical as Canonical

7import qualified AST.PrettyPrint as PP

9import qualified AST.PrettyPrint as PP

8import qualified AST.Type as T

10import qualified AST.Type as T

9import qualified AST.Variable as Var

11import qualified AST.Variable as Var

@@ -19,46 +21,44 @@ throw err =

19

21

20check

22check

21 :: String

23 :: String

24+ -> Maybe Canonical.Expr

22 -> T.CanonicalType

25 -> T.CanonicalType

23− -> Env.Canonicalizer [P.Doc] (T.PortDirection Var.Canonical)

26+ -> Env.Canonicalizer [P.Doc] D.CanonicalPort

24−check name tipe =

27+check name maybeExpr rootType =

25− checkHelp name tipe tipe

28+ checkHelp name maybeExpr rootType rootType

26

29

27

30

28checkHelp

31checkHelp

29 :: String

32 :: String

33+ -> Maybe Canonical.Expr

30 -> T.CanonicalType

34 -> T.CanonicalType

31 -> T.CanonicalType

35 -> T.CanonicalType

32− -> Env.Canonicalizer [P.Doc] (T.PortDirection Var.Canonical)

36+ -> Env.Canonicalizer [P.Doc] D.CanonicalPort

33−checkHelp name rootType tipe =

37+checkHelp name maybeExpr rootType tipe =

34 case tipe of

38 case tipe of

35− T.Aliased alias [(_,arg)] _

39+ T.Aliased _ args t ->

36− | Var.is ["Port"] "Port" alias ->

40+ checkHelp name maybeExpr rootType (T.dealias args t)

37− return T.Internal

38−

39− | Var.is ["Port"] "InboundPort" alias ->

40− do validForeignType name In arg arg

41− return (T.Inbound arg)

42

41

43− | Var.is ["Port"] "OutboundPort" alias ->

42+ T.App (T.Type stream) [arg]

43+ | Var.isStream stream ->

44+ case maybeExpr of

45+ Nothing ->

44− do validForeignType name Out arg arg

46+ do validForeignType name In arg arg

45− return (T.Outbound arg)

47+ return (D.Inbound name (T.Stream rootType arg))

46

48

47− T.Aliased _ args t ->

49+ Just expr ->

48− checkHelp name rootType (T.dealias args t)

50+ do validForeignType name Out arg arg

51+ return (D.Outbound name expr (T.Stream rootType arg))

49

52

50 _ ->

53 _ ->

51− throw $

54+ case maybeExpr of

52− [ P.text "Port Error:"

55+ Nothing ->

53− , P.nest 4 $

56+ do validForeignType name In rootType tipe

54− P.vcat $

57+ return (D.Inbound name (T.Normal rootType))

55− [ P.text ("The port named '" ++ name ++ "' has an invalid type.\n")

58+

56− , P.nest 4 (PP.pretty rootType) <> P.text "\n"

59+ Just expr ->

57− , P.text "It must be a Port.Port, Port.InboundPort, or Port.OutboundPort."

60+ do validForeignType name Out rootType tipe

58− , P.text "See the Port module for more details:"

61+ return (D.Outbound name expr (T.Normal rootType))

59− , P.text "<http://package.elm-lang.org/packages/elm-lang/core/latest/Port>"

60− ]

61− ]

62

63

64-- CHECK INBOUND AND OUTBOUND TYPES

@@ -84,7 +84,7 @@ validForeignType name portKind rootType tipe =

84 valid (T.dealias args t)

85

86 T.Type v ->

87− case any ($ v) [ Var.isJson, Var.isPrimitive, Var.isTuple ] of

87+ case any ($ v) [ Var.isJavaScript, Var.isPrimitive, Var.isTuple ] of

88 True -> return ()

89 False -> err "It contains an unsupported type"

90

@@ -130,9 +130,9 @@ foreignError name portKind rootType localType problemMessage =

130 , P.nest 4 (PP.pretty rootType) <> P.text "\n"

131 , txt [ problemMessage, ":\n" ]

132 , P.nest 4 (PP.pretty localType) <> P.text "\n"

133− , txt [ "Acceptable values for ", port, "s include:" ]

133+ , txt [ "The kinds of values that can flow through ", port, "s include:" ]

134 , txt [ " Ints, Floats, Bools, Strings, Maybes, Lists, Arrays," ]

135− , txt [ " Tuples, unit values, Json.Values, and concrete records." ]

135+ , txt [ " Tuples, JavaScript.Values, and concrete records." ]

136 ]

137 ]

138 where

src/Transform/Canonicalize/Setup.hs+2−5

@@ -326,14 +326,11 @@ addDecl moduleName info@(nodes,env) decl =

326 _values env

327 }

328

329− D.Port name _ ->

329+ D.Port port ->

330 (,) nodes $ env

331 { _values =

332− addLocal name (_values env)

332+ addLocal (D.getName port) (_values env)

333 }

334

335− D.Perform _ _ ->

336− info

337−

338 D.Fixity _ _ _ ->

335 D.Fixity _ _ _ ->

339 info

336 info

src/Transform/Check.hs+1−1

@@ -53,7 +53,7 @@ duplicateValues decls =

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

54

55 portNames =

56− [ name | D.Port name _ <- decls ]

56+ [ D.getName port | D.Port port <- decls ]

57

58 exprDups :: Valid.Expr -> Either String Valid.Expr

59 exprDups expr =

src/Transform/Declaration.hs+29−14

@@ -44,13 +44,6 @@ combineAnnotations =

44 D.Fixity assoc prec op : rest ->

45 (:) (D.Fixity assoc prec op) <$> go rest

46

47− D.Port name tipe : rest ->

48− (:) (D.Port name tipe) <$> go rest

49−

50− D.Perform line expr : rest ->

51− do expr' <- exprCombineAnnotations expr

52− (:) (D.Perform line expr') <$> go rest

53−

54 -- combine definitions

47 -- combine definitions

55 D.Definition def : defRest ->

48 D.Definition def : defRest ->

56 case def of

49 case def of

@@ -69,6 +62,22 @@ combineAnnotations =

69

62

70 _ -> Left (errorMessage "value" name)

63 _ -> Left (errorMessage "value" name)

71

64

65+ D.Port port : rest ->

66+ case port of

67+ D.PortAnnotation name tipe ->

68+ case rest of

69+ D.Port (D.PortDefinition name' expr) : restRest

70+ | name == name' ->

71+ do expr' <- exprCombineAnnotations expr

72+ let port' = D.Outbound name expr' tipe

73+ (:) (D.Port port') <$> go restRest

74+

75+ _ ->

76+ (:) (D.Port (D.Inbound name tipe)) <$> go rest

77+

78+ D.PortDefinition name _ ->

79+ Left (errorMessage "port" name)

80+

72

81

73toExpr :: Module.Name -> [D.CanonicalDecl] -> [Canonical.Def]

82toExpr :: Module.Name -> [D.CanonicalDecl] -> [Canonical.Def]

74toExpr moduleName =

83toExpr moduleName =

@@ -116,13 +125,19 @@ toDefs moduleName decl =

116 D.TypeAlias _ _ _ ->

125 D.TypeAlias _ _ _ ->

117 []

126 []

118

127

119− D.Port name tipe ->

128+ D.Port port ->

120− [ definition name (A.none $ E.Port name (T.direction tipe)) (T.tipe tipe) ]

129+ case port of

121−

130+ D.Inbound name portType ->

122− D.Perform line expr ->

131+ let portExpr = E.Port name (E.Inbound portType)

123− let name = Var.toEffectName line

132+ tipe = T.portType portType

133+ in

134+ [ definition name (A.none portExpr) tipe ]

135+

136+ D.Outbound name expr portType ->

137+ let portExpr = E.Port name (E.Outbound portType expr)

138+ tipe = T.portType portType

124− in

139+ in

125− [ Canonical.Definition (P.Var name) (A.none $ E.Perform expr) Nothing ]

140+ [ definition name (A.none portExpr) tipe ]

126

141

127 -- no constraints are needed for fixity declarations

142 -- no constraints are needed for fixity declarations

128 D.Fixity _ _ _ ->

143 D.Fixity _ _ _ ->

src/Transform/Expression.hs+8−5

@@ -69,8 +69,11 @@ crawlLet defsTransform annotatedExpression =

69 GLShader uid src gltipe ->

70 return $ GLShader uid src gltipe

71

72− Port name tipe ->

72+ Port name impl ->

73+ Port name <$>

74+ case impl of

75+ Inbound tipe ->

73− return $ Port name tipe

76+ return (Inbound tipe)

74−

77+

75− Perform expr ->

78+ Outbound tipe expr ->

76− Perform <$> go expr

79+ Outbound tipe <$> go expr

src/Transform/SortDefinitions.hs+2−5

@@ -115,11 +115,8 @@ reorder (A ann expression) =

115 GLShader _ _ _ ->

116 return expression

117

118− Port name tipe ->

118+ Port name impl ->

119− return $ Port name tipe

119+ return $ Port name impl

120−

121− Perform expr ->

122− Perform <$> reorder expr

123

120

124 -- Actually do some reordering

121 -- Actually do some reordering

125 Let defs body ->

122 Let defs body ->

src/Transform/Substitute.hs−3

@@ -85,6 +85,3 @@ subst old new expression =

85

86 Port _ _ ->

87 expression

88−

89− Perform expr ->

90− Perform (f expr)

src/Type/Constrain/Expression.hs−3

@@ -180,9 +180,6 @@ constrain env (A region expression) tipe =

180 Port _ _ ->

181 return true

182

183− Perform expr ->

184− constrain env expr tipe

185−

186

183

187expandPattern :: Canonical.Def -> [Canonical.Def]

184expandPattern :: Canonical.Def -> [Canonical.Def]

188expandPattern def@(Canonical.Definition pattern lexpr@(A r _) maybeType) =

185expandPattern def@(Canonical.Definition pattern lexpr@(A r _) maybeType) =