9dda928 · elk · git.iko.soy

git.iko.soy/elk

make conversion functions for input ports optional

commit9dda928ac4e481005a8632603283f151e51c1d50 authorEvan Czaplicki <info@elm-lang.org> dateSun 12 Jan 2014, 16:25 (13 years ago) parent828c2c7

12 files changed+38−19

compare with master

unifiedsplit

compiler/Generate/JavaScript.hs+4−2 compiler/SourceSyntax/Declaration.hs+5−2 compiler/SourceSyntax/Expression.hs+2−2 compiler/Transform/Canonicalize.hs+2−1 compiler/Transform/Check.hs+5−3 compiler/Transform/Declaration.hs+3−2 compiler/Transform/Expression.hs+2−1 compiler/Transform/SafeNames.hs+1−1 compiler/Transform/SortDefinitions.hs+3−1 compiler/Transform/Substitute.hs+1−1 compiler/Type/Constrain/Declaration.hs+6−2 compiler/Type/Constrain/Expression.hs+4−1

compiler/Generate/JavaScript.hs+4−2

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

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

198198

199199 PortIn name _ _ handler ->

200− do handler' <- expression handler

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

200+ do handler' <- case handler of

201+ Nothing -> return []

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

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

202204

203205 PortOut name _ signal ->

204206 do signal' <- expression signal

compiler/SourceSyntax/Declaration.hs+5−2

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

2929

3030data Port

3131 = Out String Expr.LExpr T.Type

32− | In String Expr.LExpr T.Type

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

3333 deriving (Show)

3434

3535type ParseDeclaration = Declaration' ParsePort Expr.ParseDef

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

108108 pretty port =

109109 case port of

110110 Out name expr tipe -> mkPort "<-" name expr tipe

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

111+ In name mexpr tipe ->

112+ case mexpr of

113+ Nothing -> prettyPort name ":" tipe

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

112115 where

113116 mkPort arrow name expr tipe =

114117 P.vcat [ prettyPort name ":" tipe

compiler/SourceSyntax/Expression.hs+2−2

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

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

4141 | Markdown String String [LExpr' def]

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

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

4545

4646type ParseExpr = Expr' ParseDef

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

129129

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

131131

132− PortIn _ _ _ handler -> pretty handler

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

133133

134134 PortOut _ _ signal -> pretty signal

135135

compiler/Transform/Canonicalize.hs+2−1

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

44import Control.Arrow ((***))

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

66import Control.Monad.Identity

7+import Data.Traversable (traverse)

78import qualified Data.Map as Map

89import qualified Data.Set as Set

910import qualified Data.List as List

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

169170

170171 PortIn name st tt handler ->

171172 do st' <- renameType' env st

172− handler' <- rnm handler

173+ handler' <- traverse rnm handler

173174 return $ PortIn name st' tt handler'

174175

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

compiler/Transform/Check.hs+5−3

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

11{-# OPTIONS_GHC -Wall #-}

22module Transform.Check (mistakes) where

4+import qualified Control.Arrow as Arrow

45import qualified Data.List as List

56import qualified Data.Maybe as Maybe

67import qualified Data.Set as Set

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

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

4546

4647 (portNames, portExprs) =

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

48+ Arrow.second Maybe.catMaybes $ unzip $

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

4850 case port of

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

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

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

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

5153

5254 getNames = Set.toList . Pattern.boundVars

5355

compiler/Transform/Declaration.hs+3−2

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

6262

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

6464 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

6668

67− _ -> Left (msg name)

compiler/Transform/Expression.hs+2−1

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

22module Transform.Expression (crawlLet, checkPorts) where

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

5+import Data.Traversable (traverse)

56import SourceSyntax.Expression

67import SourceSyntax.Location

78import qualified SourceSyntax.Type as ST

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

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

5152 PortIn name st tt handler ->

5253 do portInCheck name st tt

53− PortIn name st tt <$> go handler

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

5455 PortOut name st signal ->

5556 do portOutCheck name st

5657 PortOut name st <$> go signal

compiler/Transform/SafeNames.hs+1−1

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

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

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

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

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

5454

5555definition :: Def -> Def

compiler/Transform/SortDefinitions.hs+3−1

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

44import Control.Monad.State

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

6+import Data.Traversable (traverse)

67import qualified Data.Map as Map

78import SourceSyntax.Expression

89import SourceSyntax.Location

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

8586

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

8788

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

89+ PortIn name st tt handler ->

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

8991

9092 -- Actually do some reordering

9193 Let defs body ->

compiler/Transform/Substitute.hs+1−1

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

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

3939 Literal _ -> expr

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

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

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

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

4949 case port of

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

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

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

52+ In name mexpr tipe ->

5353 unsafePerformIO $ do

5454 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

5660

5761 -- no constraints are needed for fixity declarations

5862 Fixity _ _ _ -> []

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

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

44import qualified Data.List as List

55import qualified Data.Map as Map

6+import qualified Data.Maybe as Maybe

67import qualified Data.Set as Set

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

89import qualified Control.Monad as Monad

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

147148 (c1 /\ c))

148149

149150 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")

151154

152155 PortOut _ _ signal ->

153156 constrain env signal tipe