329077f · elk · git.iko.soy

git.iko.soy/elk

Get rid of input handlers for now

commit329077f1ef499aef93e1baa6e8e83cf8ce8b827e authorEvan Czaplicki <info@elm-lang.org> dateMon 13 Jan 2014, 19:24 (13 years ago) parentfe3b343

12 files changed+30−64

compare with master

unifiedsplit

compiler/Parse/Declaration.hs+2−3 compiler/SourceSyntax/Declaration.hs+7−14 compiler/SourceSyntax/Expression.hs+2−3 compiler/Transform/Canonicalize.hs+1−5 compiler/Transform/Check.hs+3−3 compiler/Transform/Declaration.hs+3−8 compiler/Transform/Expression.hs+6−8 compiler/Transform/SafeNames.hs+1−1 compiler/Transform/SortDefinitions.hs+1−3 compiler/Transform/Substitute.hs+1−1 compiler/Type/Constrain/Declaration.hs+2−10 compiler/Type/Constrain/Expression.hs+1−5

compiler/Parse/Declaration.hs+2−3

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

5959 name <- lowVar

6060 whitespace

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

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

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

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

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

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

compiler/SourceSyntax/Declaration.hs+7−14

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

2323

2424data ParsePort

2525 = PPAnnotation String T.Type

26− | PPOut String Expr.LParseExpr

27− | PPIn String Expr.LParseExpr

26+ | PPDef String Expr.LParseExpr

2827 deriving (Show)

2928

3029data Port

3130 = Out String Expr.LExpr T.Type

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

31+ | In String T.Type

3332 deriving (Show)

3433

3534type ParseDeclaration = Declaration' ParsePort Expr.ParseDef

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

101100 pretty port =

102101 case port of

103102 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

106104

107105instance Pretty Port where

108106 pretty port =

109107 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

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

115− where

116− mkPort arrow name expr tipe =

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

118− , prettyPort name arrow expr ]

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

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

110+ , prettyPort name "=" expr ]

111+

119112

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

121114prettyPort 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

88import qualified SourceSyntax.Pattern as Pattern

99import qualified SourceSyntax.Type as SrcType

1010import qualified SourceSyntax.Literal as Literal

11−import qualified Type.Type as Type

1211

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

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

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

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

4140 | Markdown String String [LExpr' def]

4241 -- for type checking and code gen only

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

42+ | PortIn String SrcType.Type

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

4544

4645type ParseExpr = Expr' ParseDef

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

129128

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

131130

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

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

133132

134133 PortOut _ _ signal -> pretty signal

135134

compiler/Transform/Canonicalize.hs+1−5

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

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

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

66import Control.Monad.Identity

7−import Data.Traversable (traverse)

87import qualified Data.Map as Map

98import qualified Data.Set as Set

109import qualified Data.List as List

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

167166

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

169168

170− PortIn name st tt handler ->

171− do st' <- renameType' env st

172− handler' <- traverse rnm handler

173− return $ PortIn name st' tt handler'

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

174170

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

176172

compiler/Transform/Check.hs+3−3

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

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

4646

4747 (portNames, portExprs) =

48− Arrow.second Maybe.catMaybes $ unzip $

48+ Arrow.second concat $ unzip $

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

5050 case port of

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

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

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

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

5353

5454 getNames = Set.toList . Pattern.boundVars

5555

compiler/Transform/Declaration.hs+3−8

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

5252 -- combine ports

5353 Port port : portRest ->

5454 case port of

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

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

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

5756 PPAnnotation name tipe ->

5857 case portRest of

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

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

6059 do expr' <- exprCombineAnnotations expr

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

6261

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

6863

compiler/Transform/Expression.hs+6−8

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

22module Transform.Expression (crawlLet, checkPorts) where

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

5−import Data.Traversable (traverse)

65import SourceSyntax.Expression

76import SourceSyntax.Location

87import qualified SourceSyntax.Type as ST

9−import qualified Type.Type as TT

108

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

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

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

1311

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

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

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

1614 -> LExpr

1715 -> Either a LExpr

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

2220 do _ <- checkPorts inCheck outCheck body

2321 return def

2422

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

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

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

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

2826 -> LExpr' def

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

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

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

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

52− PortIn name st tt handler ->

53− do portInCheck name st tt

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

50+ PortIn name st ->

51+ do portInCheck name st

52+ return $ PortIn name st

5553 PortOut name st signal ->

5654 do portOutCheck name st

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

52+ PortIn name st -> PortIn name st

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

5454

5555definition :: Def -> Def

compiler/Transform/SortDefinitions.hs+1−3

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

44import Control.Monad.State

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

6−import Data.Traversable (traverse)

76import qualified Data.Map as Map

87import SourceSyntax.Expression

98import SourceSyntax.Location

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

8685

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

8887

89− PortIn name st tt handler ->

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

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

9189

9290 -- Actually do some reordering

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

41+ PortIn name st -> PortIn name st

4242 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

66import qualified SourceSyntax.Location as L

77import qualified SourceSyntax.Pattern as P

88import qualified SourceSyntax.Type as T

9−import qualified Type.Type as Type

10−import System.IO.Unsafe

119

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

1311toExpr = concatMap toDefs

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

4745 case port of

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

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

50− In name mexpr tipe ->

51− unsafePerformIO $ do

52− tvar <- Type.var Type.Flexible

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

54− where

55− loc = case mexpr of

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

57− Nothing -> L.none

48+ In name tipe ->

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

5850

5951 -- no constraints are needed for fixity declarations

6052 Fixity _ _ _ -> []

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

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

44import qualified Data.List as List

55import qualified Data.Map as Map

6−import qualified Data.Maybe as Maybe

76import qualified Data.Set as Set

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

98import qualified Control.Monad as Monad

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

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

148147 (c1 /\ c))

149148

150− PortIn _ _ tt handler ->

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

152− where

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

149+ PortIn _ _ -> return true

154150

155151 PortOut _ _ signal ->

156152 constrain env signal tipe