b26edcc · elk · git.iko.soy

git.iko.soy/elk

Simplify representation of source locations

commitb26edcc46e7f9ac8452e1621a013b07e74392a5b authorEvan Czaplicki <info@elm-lang.org> dateTue 30 Jul 2013, 11:43 (13 years ago) parentb3cc261

13 files changed+47−54

compare with master

unifiedsplit

compiler/Generate/Cases.hs+6−7 compiler/Generate/JavaScript.hs+7−7 compiler/Generate/Noscript.hs+4−4 compiler/Parse/Expression.hs+3−4 compiler/Parse/Helpers.hs+1−1 compiler/SourceSyntax/Expression.hs+5−5 compiler/SourceSyntax/Location.hs+8−13 compiler/SourceSyntax/PrettyPrint.hs+1−1 compiler/Transform/Canonicalize.hs+2−2 compiler/Transform/SortDefinitions.hs+5−5 compiler/Transform/Substitute.hs+1−1 compiler/Type/Constrain/Declaration.hs+2−2 compiler/Type/Constrain/Expression.hs+2−2

compiler/Generate/Cases.hs+6−7

@@ -35,8 +35,8 @@ matchSubst :: [(String,String)] -> Match t v -> Match t v

3535matchSubst _ Break = Break

3636matchSubst _ Fail = Fail

3737matchSubst pairs (Seq ms) = Seq (map (matchSubst pairs) ms)

38−matchSubst pairs (Other (L t s e)) =

39− Other . L t s $ foldr ($) e $ map (\(x,y) -> subst x (Var y)) pairs

38+matchSubst pairs (Other (L s e)) =

39+ Other . L s $ foldr ($) e $ map (\(x,y) -> subst x (Var y)) pairs

4040matchSubst pairs (Match n cs m) =

4141 Match (varSubst n) (map clauseSubst cs) (matchSubst pairs m)

4242 where varSubst v = fromMaybe v (lookup v pairs)

@@ -63,24 +63,23 @@ match vs@(v:_) cs def

6363 where

6464 cs' = map (dealias v) cs

6565

66−dealias v c@(p:ps, L t s e) =

66+dealias v c@(p:ps, L s e) =

6767 case p of

68− PAlias x pattern -> (pattern:ps, L t s $ subst x (Var v) e)

68+ PAlias x pattern -> (pattern:ps, L s $ subst x (Var v) e)

6969 _ -> c

7070

7171matchVar :: [String] -> [([Pattern],LExpr t v)] -> Match t v

7272 -> Unique (Match t v)

7373matchVar (v:vs) cs def = match vs (map subVar cs) def

7474 where

75− subVar (p:ps, ce@(L t s e)) = (ps, L t s $ subOnePattern p e)

75+ subVar (p:ps, ce@(L s e)) = (ps, L s $ subOnePattern p e)

7676 where

77− loc = L t s

7877 subOnePattern pattern e =

7978 case pattern of

8079 PVar x -> subst x (Var v) e

8180 PAnything -> e

8281 PRecord fs ->

83− foldr (\x -> subst x (Access (loc (Var v)) x)) e fs

82+ foldr (\x -> subst x (Access (L s (Var v)) x)) e fs

8483

8584matchCon :: [String] -> [([Pattern],LExpr t v)] -> Match t v

8685 -> Unique (Match t v)

compiler/Generate/JavaScript.hs+7−7

@@ -147,7 +147,7 @@ instance ToJS a => ToJS [a] where

147147 toJS xs = concat `liftM` mapM toJS xs

148148

149149toJS' :: LExpr t v -> Unique String

150−toJS' (L txt span expr) =

150+toJS' (L span expr) =

151151 case expr of

152152 MultiIf ps -> multiIfToJS span ps

153153 Case e cases -> caseToJS span e cases

@@ -211,7 +211,7 @@ instance ToJS (Expr t v) where

211211

212212 (patterns, innerBody) = collect [p] e

213213

214− collect patterns lexpr@(L a b expr) =

214+ collect patterns lexpr@(L _ expr) =

215215 case expr of

216216 Lambda p e -> collect (p:patterns) e

217217 _ -> (patterns, lexpr)

@@ -245,7 +245,7 @@ jsApp e1 e2 =

245245 (func, args) = go [e2] e1

246246 go args e =

247247 case e of

248− (L _ _ (App e1 e2)) -> go (e2 : args) e1

248+ (L _ (App e1 e2)) -> go (e2 : args) e1

249249 _ -> (e, args)

250250

251251formatMarkdown = concatMap f

@@ -256,7 +256,7 @@ formatMarkdown = concatMap f

256256

257257multiIfToJS span ps =

258258 case last ps of

259− (L _ _ (Var "otherwise"), e) -> toJS' e >>= \b -> format b (init ps)

259+ (L _ (Var "otherwise"), e) -> toJS' e >>= \b -> format b (init ps)

260260 _ -> format ("_E.If" ++ parens (quoted (show span))) ps

261261 where

262262 format base ps =

@@ -273,9 +273,9 @@ caseToJS span e ps = do

273273 match <- caseToMatch ps

274274 e' <- toJS' e

275275 let (match',stmt) = case (match,e) of

276− (Match name _ _, L _ _ (Var x)) -> (matchSubst [(name,deprime x)] match, "")

277− (Match name _ _, _) -> (match, assign name e')

278− _ -> (match, "")

276+ (Match name _ _, L _ (Var x)) -> (matchSubst [(name,deprime x)] match, "")

277+ (Match name _ _, _) -> (match, assign name e')

278+ _ -> (match, "")

279279 matches <- matchToJS span match'

280280 return $ "function(){ " ++ stmt ++ matches ++ " }()"

281281

compiler/Generate/Noscript.hs+4−4

@@ -23,7 +23,7 @@ instance Extract (Def t v) where

2323 extract _ = []

2424

2525instance Extract e => Extract (Located e) where

26− extract (L _ _ e) = extract e

26+ extract (L _ e) = extract e

2727

2828instance Extract (Expr t v) where

2929 extract expr =

@@ -34,11 +34,11 @@ instance Extract (Expr t v) where

3434 ("++", [s1], [s2]) -> [s1 ++ s2]

3535 (_ , ss1 , ss2 ) -> ss1 ++ ss2

3636 Lambda v e -> f e

37− App (L _ _ (App (L _ _ (App (L _ _ (Var func)) w)) h)) src

37+ App (L _ (App (L _ (App (L _ (Var func)) w)) h)) src

3838 | "image" `isInfixOf` func -> extractImage src

39− App (L _ _ (App (L _ _ (Var func)) src)) txt

39+ App (L _ (App (L _ (Var func)) src)) txt

4040 | "link" `isInfixOf` func -> extractLink src txt

41− App (L _ _ (Var func)) e

41+ App (L _ (Var func)) e

4242 | "header" `isInfixOf` func -> tag "h1" e

4343 | "bold" `isInfixOf` func -> tag "b" e

4444 | "italic" `isInfixOf` func -> tag "i" e

compiler/Parse/Expression.hs+3−4

@@ -36,7 +36,7 @@ accessor = do

3636 start <- getPosition

3737 lbl <- try (string "." >> rLabel)

3838 end <- getPosition

39− let loc e = Location.add ("." ++ lbl) (Location.at start end e)

39+ let loc e = Location.at start end e

4040 return (Lambda (PVar "_") (loc $ Access (loc $ Var "_") lbl))

4141

4242negative :: IParser (Expr t v)

@@ -215,9 +215,8 @@ funcDef =

215215 else [ PVar (o:p), p1, p2 ]

216216

217217makeFunction :: [Pattern] -> LExpr t v -> LExpr t v

218−makeFunction args body@(L a b _) =

219− let pos = L a b in

220− foldr (\arg body' -> pos $ Lambda arg body') body args

218+makeFunction args body@(L s _) =

219+ foldr (\arg body' -> L s $ Lambda arg body') body args

221220

222221assignExpr :: IParser (Def t v)

223222assignExpr = withPos $ do

compiler/Parse/Helpers.hs+1−1

@@ -140,7 +140,7 @@ addLocation expr = do

140140accessible :: IParser (LExpr t v) -> IParser (LExpr t v)

141141accessible expr = do

142142 start <- getPosition

143− ce@(L s t e) <- expr

143+ ce@(L _ e) <- expr

144144 let rest f = do

145145 let dot = char '.' >> notFollowedBy (char '.')

146146 access <- optionMaybe (try dot <?> "field access (e.g. List.map)")

compiler/SourceSyntax/Expression.hs+5−5

@@ -40,7 +40,7 @@ data Def tipe var

4040

4141tuple es = Data ("_Tuple" ++ show (length es)) es

4242

43−delist (Location.L _ _ (Data "::" [h,t])) = h : delist t

43+delist (Location.L _ (Data "::" [h,t])) = h : delist t

4444delist _ = []

4545

4646saveEnvName = "_save_the_environment!!!"

@@ -77,7 +77,7 @@ instance Pretty (Expr t v) where

7777 Data name es -> P.hang (P.text name) 2 (P.sep (map prettyParens es))

7878 Access e x -> prettyParens e <> P.text "." <> P.text x

7979 Remove e x -> P.braces (pretty e <+> P.text "-" <+> P.text x)

80− Insert (Location.L _ _ (Remove e y)) x v ->

80+ Insert (Location.L _ (Remove e y)) x v ->

8181 P.braces (pretty e <+> P.text "-" <+> P.text y <+> P.text "|" <+> P.text x <+> P.text "=" <+> pretty v)

8282 Insert e x v ->

8383 P.braces (pretty e <+> P.text "|" <+> P.text x <+> P.text "=" <+> pretty v)

@@ -104,19 +104,19 @@ instance Pretty (Def t v) where

104104 Def pattern expr ->

105105 pretty pattern <+> P.text "=" <+> pretty expr

106106

107−collectApps lexpr@(Location.L _ _ expr) =

107+collectApps lexpr@(Location.L _ expr) =

108108 case expr of

109109 App a b -> collectApps a ++ [b]

110110 _ -> [lexpr]

111111

112−collectLambdas lexpr@(Location.L _ _ expr) =

112+collectLambdas lexpr@(Location.L _ expr) =

113113 case expr of

114114 Lambda pattern body ->

115115 let (ps, body') = collectLambdas body

116116 in (pretty pattern : ps, body')

117117 _ -> ([], lexpr)

118118

119−prettyParens (Location.L _ _ expr) = parensIf needed (pretty expr)

119+prettyParens (Location.L _ expr) = parensIf needed (pretty expr)

120120 where

121121 needed =

122122 case expr of

compiler/SourceSyntax/Location.hs+8−13

@@ -1,16 +1,16 @@

11{-# LANGUAGE DeriveDataTypeable #-}

22module SourceSyntax.Location where

4−import Text.Parsec.Pos

4+import qualified Text.Parsec.Pos as Parsec

55import Data.Data

7−data SrcPos = Pos Int Int

7+data SrcPos = Pos { line :: Int, column :: Int }

88 deriving (Eq, Ord, Data, Typeable)

1010data SrcSpan = Span SrcPos SrcPos | NoSpan

1111 deriving (Eq, Ord, Data, Typeable)

1212

13−data Located e = L (Maybe String) SrcSpan e

13+data Located e = L SrcSpan e

1414 deriving (Eq, Ord, Data, Typeable)

1515

1616

@@ -24,21 +24,16 @@ instance Show SrcSpan where

2424 NoSpan -> ""

2525

2626instance Show e => Show (Located e) where

27− show (L _ _ e) = show e

27+ show (L _ e) = show e

2828

2929

30+none = L NoSpan

3031

31−none = L Nothing NoSpan

32+at start end = L (Span (Pos (Parsec.sourceLine start) (Parsec.sourceColumn start))

33+ (Pos (Parsec.sourceLine end ) (Parsec.sourceColumn end )))

3234

33−at start end = L Nothing

34− (Span (Pos (sourceLine start) (sourceColumn start))

35− (Pos (sourceLine end ) (sourceColumn end )))

36−

37−merge (L _ s1 _) (L _ s2 _) = L Nothing span

35+merge (L s1 _) (L s2 _) = L span

3836 where span = case (s1,s2) of

3937 (Span start _, Span _ end) -> Span start end

4038 (_, NoSpan) -> s1

4139 (NoSpan, _) -> s2

42−

43−add x (L Nothing span e) = L (Just (show x)) span e

44−add x (L txt span e) = L txt span e

compiler/SourceSyntax/PrettyPrint.hs+1−1

@@ -9,7 +9,7 @@ class Pretty a where

99 pretty :: a -> Doc

1010

1111instance Pretty a => Pretty (Located a) where

12− pretty (L _ _ e) = pretty e

12+ pretty (L _ e) = pretty e

1313

1414instance Pretty () where

1515 pretty () = empty

compiler/Transform/Canonicalize.hs+2−2

@@ -101,12 +101,12 @@ replace env v =

101101 "\nClose matches include: " ++ List.intercalate ", " matches

102102

103103rename :: Env -> LExpr t v -> Either [Doc] (LExpr t v)

104−rename env lexpr@(L t s expr) =

104+rename env lexpr@(L s expr) =

105105 let rnm = rename env

106106 throw err = Left [ P.text $ "Error " ++ show s ++ "\n" ++ err ]

107107 format = Either.either throw return

108108 in

109− L t s `liftM`

109+ L s `liftM`

110110 case expr of

111111 Literal lit -> return expr

112112

compiler/Transform/SortDefinitions.hs+5−5

@@ -40,15 +40,15 @@ bound boundVars = modify (\freeVars -> Set.difference freeVars boundVars)

4040sortDefs :: LExpr t v -> LExpr t v

4141sortDefs expr = evalState (reorder expr) Set.empty

4242

43−flattenLets defs lexpr@(L _ _ expr) =

43+flattenLets defs lexpr@(L _ expr) =

4444 case expr of

4545 Let ds body -> flattenLets (defs ++ ds) body

4646 _ -> (defs, lexpr)

4747

4848

4949reorder :: LExpr t v -> State (Set.Set String) (LExpr t v)

50−reorder lexpr@(L a b expr) =

51− L a b `liftM`

50+reorder lexpr@(L s expr) =

51+ L s `liftM`

5252 case expr of

5353 -- Be careful adding and restricting freeVars

5454 Var x -> free x >> return expr

@@ -119,13 +119,13 @@ reorder lexpr@(L a b expr) =

119119 bound (boundVars pattern)

120120 mapM free (ctors pattern)

121121

122− let addDefs ds bod = L a b (Let (concatMap toDefs ds) bod)

122+ let addDefs ds bod = L s (Let (concatMap toDefs ds) bod)

123123 where

124124 toDefs (pattern, expr, Nothing) = [ Def pattern expr ]

125125 toDefs (PVar name, expr, Just tipe) =

126126 [ TypeAnnotation name tipe, Def (PVar name) expr ]

127127

128− L _ _ let' = foldr addDefs body' defss

128+ L _ let' = foldr addDefs body' defss

129129

130130 return let'

131131

compiler/Transform/Substitute.hs+1−1

@@ -7,7 +7,7 @@ import Control.Arrow (second, (***))

88subst :: String -> Expr t v -> Expr t v -> Expr t v

99subst old new expr =

10− let f (L t s e) = L t s (subst old new e) in

10+ let f (L s e) = L s (subst old new e) in

1111 case expr of

1212 Range e1 e2 -> Range (f e1) (f e2)

1313 ExplicitList es -> ExplicitList (map f es)

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

@@ -50,9 +50,9 @@ toDefs decl =

5050 -- but they do not require any basic constraints.

5151 TypeAlias _ _ _ -> []

5252

53− ImportEvent _ expr@(Src.L a b _) name tipe ->

53+ ImportEvent _ expr@(Src.L s _) name tipe ->

5454 [ Src.TypeAnnotation name tipe

55− , Src.Def (Src.PVar name) (Src.L a b $ Src.App (Src.L a b $ Src.Var "constant") expr) ]

55+ , Src.Def (Src.PVar name) (Src.L s $ Src.App (Src.L s $ Src.Var "constant") expr) ]

5656

5757 ExportEvent _ name tipe ->

5858 [ Src.TypeAnnotation name tipe ]

compiler/Type/Constrain/Expression.hs+2−2

@@ -22,7 +22,7 @@ import qualified Transform.SortDefinitions as SD

2222

2323

2424constrain :: Env.Environment -> LExpr a b -> Type -> IO TypeConstraint

25−constrain env (L _ _ expr) tipe =

25+constrain env (L _ expr) tipe =

2626 let list t = Env.get env Env.types "_List" <| t in

2727 case expr of

2828 Literal lit -> Literal.constrain env lit tipe

@@ -132,7 +132,7 @@ constrain env (L _ _ expr) tipe =

132132

133133 Let defs body ->

134134 do c <- case body of

135− L _ _ (Var name) | name == saveEnvName -> return CSaveEnv

135+ L _ (Var name) | name == saveEnvName -> return CSaveEnv

136136 _ -> constrain env body tipe

137137 (schemes, rqs, fqs, header, c2, c1) <-

138138 Monad.foldM (constrainDef env)