0d83d8d · elk · git.iko.soy

src/AST/Declaration.hs+55−13

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

1313

1414-- DECLARATIONS

1515

16−data Declaration' portType def var expr

16+data Declaration' port def var expr

1717 = Definition def

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

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

20− | Port String portType

21− | Perform Int expr

20+ | Port port

2221 | Fixity Assoc Int String

2322

2423

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

2928-- DECLARATION PHASES

3029

3130type SourceDecl =

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

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

3332

3433

3534type ValidDecl =

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

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

3736

3837

3938type 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

4163

4264

4365-- BINARY CONVERSION

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

6991 R -> "right"

7092

7193

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

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

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

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

7496 pretty decl =

7597 case decl of

7698 Definition def -> pretty def

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

96118 name' =

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

98120

99− Port name tipe ->

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

101−

102− Perform _ expr ->

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

121+ Port port ->

122+ pretty port

104123

105124 Fixity assoc prec op ->

106125 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

110129 L -> P.text "l"

111130 N -> P.empty

112131 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

1010

1111import AST.PrettyPrint

1212import Text.PrettyPrint as P

13−import AST.Type (PortDirection)

1413

1514import qualified AST.Annotation as Annotation

1615import qualified AST.Helpers as Help

1716import qualified AST.Literal as Literal

1817import qualified AST.Pattern as Pattern

18+import qualified AST.Type as Type

1919import qualified AST.Variable as Var

2020

2121

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

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

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

6060 -- 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)

6362 | GLShader String String Literal.GLShaderTipe

6463 deriving (Show)

6564

6665

66+data PortImpl expr var

67+ = Inbound (Type.PortType var)

68+ | Outbound (Type.PortType var) expr

69+ deriving (Show)

70+

71+

6772---- UTILITIES ----

6873

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

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

198203 Port name _ ->

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

200205

201− Perform expr ->

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

203−

204206

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

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

src/AST/Type.hs+15−11

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

11module AST.Type

22 ( Type(..), AliasType(..)

33 , RawType, CanonicalType

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

4+ , PortType(..), portType

55 , fieldMap, recordOf, listOf, tupleOf

66 , deepDealias, dealias

77 , collectLambdas

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

4545 Type Var.Canonical

4646

4747

48−data PortType var = PortType

49− { direction :: PortDirection var

50− , tipe :: Type var

51− }

48+data PortType var

49+ = Normal (Type var)

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

5251 deriving (Show)

5352

5453

55−data PortDirection var

56− = Inbound (Type var)

57− | Internal

58− | Outbound (Type var)

59− deriving (Show)

54+portType :: PortType var -> Type var

55+portType portType =

56+ case portType of

57+ Normal tipe -> tipe

58+ Stream tipe _ -> tipe

6059

6160

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

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

146145

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

148147 pretty portType =

149− pretty (tipe portType)

148+ case portType of

149+ Normal tipe ->

150+ pretty tipe

151+

152+ Stream tipe _ ->

153+ pretty tipe

150154

151155

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

src/AST/Variable.hs+8−3

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

6161 var == Canonical (Module home) name

6262

6363

64−isJson :: Canonical -> Bool

65−isJson =

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

64+isJavaScript :: Canonical -> Bool

65+isJavaScript =

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

6767

6868

6969isMaybe :: Canonical -> Bool

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

8080 is ["Task"] "Task"

8181

8282

83+isStream :: Canonical -> Bool

84+isStream =

85+ is ["SignalTypes"] "Stream"

86+

87+

8388isList :: Canonical -> Bool

8489isList v =

8590 v == Canonical BuiltIn "List"

src/Docs.hs+1−4

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

213213 in

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

215215

216− Decl.Port _ _ ->

216+ Decl.Port _ ->

217217 error (errorMessage "ports")

218218

219− Decl.Perform _ _ ->

220− error (errorMessage "perform declarations")

221−

222219

223220errorMessage :: String -> String

224221errorMessage name =

src/Generate/JavaScript.hs+13−12

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

1818import AST.Module

1919import AST.Expression.General

2020import qualified AST.Expression.Canonical as Canonical

21−import qualified AST.Module as Module

2221import qualified AST.Helpers as Help

2322import AST.Literal

23+import qualified AST.Module as Module

2424import qualified AST.Pattern as P

25−import qualified AST.Type as T

25+import qualified AST.Type as Type

2626import qualified AST.Variable as Var

2727

2828

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

207207 GLShader _uid src _tipe ->

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

209209

210− Port name portType ->

211− case portType of

212− T.Inbound tipe ->

210+ Port name impl ->

211+ case impl of

212+ Inbound (Type.Normal tipe) ->

213213 return (Port.inbound name tipe)

214214

215− T.Internal ->

216− return (Port.internal name)

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

216+ return (Port.inboundStream name tipe)

217217

218− T.Outbound tipe ->

219− return (Port.outbound name tipe)

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

219+ do expr' <- expression expr

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

220221

221− Perform expr ->

222− do expr' <- expression expr

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

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

223+ do expr' <- expression expr

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

224225

225226

226227definition :: 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

25

36import qualified Data.List as List

4−import Generate.JavaScript.Helpers

7+import Language.ECMAScript3.Syntax

8+

59import AST.PrettyPrint (pretty)

610import AST.Type as T

711import qualified AST.Variable as Var

8−import Language.ECMAScript3.Syntax

12+import Generate.JavaScript.Helpers

913

1014

1115data JSType

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

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

6872

6973

70−-- INTERNAL

71−

72−internal :: String -> Expression ()

73−internal name =

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

75−

76−

7774-- INBOUND

7875

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

8077inbound name tipe =

81− _Port "inbound" `call`

82− [ string name

83− , string (show (pretty tipe))

84− , toTypeFunction tipe

85− ]

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`

88+ [ string name

89+ , string (show (pretty tipe))

90+ , toTypeFunction tipe

91+ ]

8692

8793

8894toTypeFunction :: CanonicalType -> Expression ()

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

111117 from checks = check x checks x

112118

113119 Type name

114− | Var.isJson name ->

120+ | Var.isJavaScript name ->

115121 x

116122

117123 | Var.isTuple name ->

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

172178

173179-- OUTBOUND

174180

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

176−outbound name tipe =

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

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

182+outbound name tipe expr =

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 ]

178189

179190

180191fromTypeFunction :: CanonicalType -> Expression ()

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

212223 x

213224

214225 Type name

215− | Var.isJson name -> x

226+ | Var.isJavaScript name -> x

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

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

218229

src/Parse/Declaration.hs+15−15

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

22module Parse.Declaration where

33

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

5−import Text.Parsec

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

7− , optionMaybe, sourceLine, string, try

8− )

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

96

107import qualified AST.Declaration as D

118import qualified Parse.Expression as Expr

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

1512

1613declaration :: IParser D.SourceDecl

1714declaration =

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

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

1916

2017

2118definition :: IParser D.SourceDecl

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

6259 do try (reserved "port")

6360 whitespace

6461 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

7462 whitespace

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

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

74+ expr <- Expr.expr

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

7676

src/Transform/Canonicalize.hs+28−21

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

99import qualified Data.Traversable as T

1010

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

12+import qualified AST.Expression.General as E

1213import qualified AST.Expression.Valid as Valid

1314import qualified AST.Expression.Canonical as Canonical

1415

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

7778 , aliases =

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

7980 , ports =

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

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

8182 }

8283

8384

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

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

203204 return (D.TypeAlias name tvars expanded')

204205

205− D.Port name tipe ->

206+ D.Port port ->

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

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

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

209− portDirection <- Port.check name tipe'

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

209+ case port of

210+ D.Inbound name tipe ->

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

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

213+ return (D.Port port')

211214

212− D.Perform line expr ->

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

214− expr' <- expression env expr

215− return $ D.Perform line expr'

215+

216+ D.Outbound name expr tipe ->

217+ do expr' <- expression env expr

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

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

220+ return (D.Port port')

216221

217222 D.Fixity assoc prec op ->

218223 return $ D.Fixity assoc prec op

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

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

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

306311

307− Port name direction ->

308− Port name <$>

309− case direction of

310− Type.Inbound tipe ->

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

312−

313− Type.Internal ->

314− return Type.Internal

312+ Port name impl ->

313+ let portType pt =

314+ case pt of

315+ Type.Normal t ->

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

315317

316− Type.Outbound tipe ->

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

318+ Type.Stream root arg ->

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

318325

319− Perform expr ->

320− Perform <$> go expr

326+ E.Outbound pt expr ->

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

321328

322329 GLShader uid src tipe ->

323330 return (GLShader uid src tipe)

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

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

44import Control.Monad.Error (throwError)

55import Text.PrettyPrint as P

66

7+import qualified AST.Declaration as D

8+import qualified AST.Expression.Canonical as Canonical

79import qualified AST.PrettyPrint as PP

810import qualified AST.Type as T

911import qualified AST.Variable as Var

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

1921

2022check

2123 :: String

24+ -> Maybe Canonical.Expr

2225 -> T.CanonicalType

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

24−check name tipe =

25− checkHelp name tipe tipe

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

27+check name maybeExpr rootType =

28+ checkHelp name maybeExpr rootType rootType

2629

2730

2831checkHelp

2932 :: String

33+ -> Maybe Canonical.Expr

3034 -> T.CanonicalType

3135 -> T.CanonicalType

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

33−checkHelp name rootType tipe =

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

37+checkHelp name maybeExpr rootType tipe =

3438 case tipe of

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

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

37− return T.Internal

38−

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

40− do validForeignType name In arg arg

41− return (T.Inbound arg)

39+ T.Aliased _ args t ->

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

4241

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

44− do validForeignType name Out arg arg

45− return (T.Outbound arg)

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

43+ | Var.isStream stream ->

44+ case maybeExpr of

45+ Nothing ->

46+ do validForeignType name In arg arg

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

4648

47− T.Aliased _ args t ->

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

49+ Just expr ->

50+ do validForeignType name Out arg arg

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

4952

5053 _ ->

51− throw $

52− [ P.text "Port Error:"

53− , P.nest 4 $

54− P.vcat $

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

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

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

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

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

60− ]

61− ]

54+ case maybeExpr of

55+ Nothing ->

56+ do validForeignType name In rootType tipe

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

58+

59+ Just expr ->

60+ do validForeignType name Out rootType tipe

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

6262

6363

6464-- CHECK INBOUND AND OUTBOUND TYPES

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

8484 valid (T.dealias args t)

8585

8686 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

8888 True -> return ()

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

9090

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

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

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

132132 , 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:" ]

134134 , 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." ]

136136 ]

137137 ]

138138 where

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

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

326326 _values env

327327 }

328328

329− D.Port name _ ->

329+ D.Port port ->

330330 (,) nodes $ env

331331 { _values =

332− addLocal name (_values env)

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

333333 }

334334

335− D.Perform _ _ ->

336− info

337−

338335 D.Fixity _ _ _ ->

339336 info

src/Transform/Check.hs+1−1

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

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

5454

5555 portNames =

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

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

5757

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

5959 exprDups expr =

src/Transform/Declaration.hs+29−14

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

4444 D.Fixity assoc prec op : rest ->

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

4646

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−

5447 -- combine definitions

5548 D.Definition def : defRest ->

5649 case def of

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

6962

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

7164

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+

7281

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

7483toExpr moduleName =

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

116125 D.TypeAlias _ _ _ ->

117126 []

118127

119− D.Port name tipe ->

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

121−

122− D.Perform line expr ->

123− let name = Var.toEffectName line

124− in

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

128+ D.Port port ->

129+ case port of

130+ D.Inbound name portType ->

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

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

139+ in

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

126141

127142 -- no constraints are needed for fixity declarations

128143 D.Fixity _ _ _ ->

src/Transform/Expression.hs+8−5

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

6969 GLShader uid src gltipe ->

7070 return $ GLShader uid src gltipe

7171

72− Port name tipe ->

73− return $ Port name tipe

74−

75− Perform expr ->

76− Perform <$> go expr

72+ Port name impl ->

73+ Port name <$>

74+ case impl of

75+ Inbound tipe ->

76+ return (Inbound tipe)

77+

78+ Outbound tipe expr ->

79+ Outbound tipe <$> go expr

src/Transform/SortDefinitions.hs+2−5

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

115115 GLShader _ _ _ ->

116116 return expression

117117

118− Port name tipe ->

119− return $ Port name tipe

120−

121− Perform expr ->

122− Perform <$> reorder expr

118+ Port name impl ->

119+ return $ Port name impl

123120

124121 -- Actually do some reordering

125122 Let defs body ->

src/Transform/Substitute.hs−3

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

8585

8686 Port _ _ ->

8787 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 =

180180 Port _ _ ->

181181 return true

182182

183− Perform expr ->

184− constrain env expr tipe

185−

186183

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

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