9ec51f5 · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

deprime on parsing, not on JS generation

9ec51f5Evan Czaplicki13 years ago

compiler/Generate/Cases.hs+3−6

compare with master

unifiedsplit

@@ -1,4 +1,4 @@

1−module Generate.Cases (caseToMatch, Match (..), Clause (..), matchSubst, deprime) where

1+module Generate.Cases (caseToMatch, Match (..), Clause (..), matchSubst) where

3import Control.Arrow (first)

4import Control.Monad (liftM,foldM)

@@ -12,9 +12,6 @@ import SourceSyntax.Pattern

12import SourceSyntax.Expression

13import Transform.Substitute

15−deprime :: String -> String

16−deprime = map (\c -> if c == '\'' then '$' else c)

17−

18caseToMatch patterns = do

15caseToMatch patterns = do

19 v <- newVar

16 v <- newVar

20 (,) v `liftM` match [v] (map (first (:[])) patterns) Fail

17 (,) v `liftM` match [v] (map (first (:[])) patterns) Fail

@@ -68,7 +65,7 @@ match vs@(v:_) cs def

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

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

70 case p of

67 case p of

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

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

72 _ -> c

69 _ -> c

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

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

@@ -79,7 +76,7 @@ matchVar (v:vs) cs def = match vs (map subVar cs) def

79 where

76 where

80 subOnePattern pattern e =

77 subOnePattern pattern e =

81 case pattern of

78 case pattern of

82− PVar x -> subst (deprime x) (Var v) e

79+ PVar x -> subst x (Var v) e

83 PAnything -> e

80 PAnything -> e

84 PRecord fs ->

81 PRecord fs ->

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

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

compiler/Generate/JavaScript.hs+12−13

@@ -10,7 +10,7 @@ import Data.Either (partitionEithers)

10import qualified Text.Pandoc as Pan

12import Unique

13−import Generate.Cases (caseToMatch, deprime, matchSubst, Match(..), Clause(..))

13+import Generate.Cases

14import SourceSyntax.Everything

15import SourceSyntax.Location

16import qualified Transform.SortDefinitions as SD

@@ -75,7 +75,7 @@ jsModule modul =

75 jsExports = setup ("elm" : names modul) ++

76 ret (assign' ("elm." ++ modName) (brackets exs))

77 where

78− exs = indent . commaSep . concatMap (pair . deprime) $ "_op" : exports modul

78+ exs = indent . commaSep . concatMap pair $ "_op" : exports modul

79 pair x | isOp x = []

80 | otherwise = ["\n" ++ x ++ " : " ++ x]

@@ -120,14 +120,13 @@ instance ToJS (Def t v) where

120 -- TODO: Make this handle patterns besides plain variables

121 toJS (Def (PVar x) e)

122 | isOp x = globalAssign ("_op['" ++ x ++ "']") `liftM` toJS' e

123− | otherwise = assign (deprime x) `liftM` toJS' e

123+ | otherwise = assign x `liftM` toJS' e

124

125 toJS (Def pattern e@(L s _)) =

126 do n <- guid

127 let x = "_" ++ show n

128 var = L s . Var

129− toDef y' = let y = deprime y' in

130− Def (PVar y) (L s $ Case (var x) [(pattern, var y)])

129+ toDef y = Def (PVar y) (L s $ Case (var x) [(pattern, var y)])

131 stmt <- assign x `liftM` toJS' e

130 stmt <- assign x `liftM` toJS' e

132 vars <- toJS . map toDef . Set.toList $ SD.boundVars pattern

131 vars <- toJS . map toDef . Set.toList $ SD.boundVars pattern

133 return (stmt ++ vars)

132 return (stmt ++ vars)

@@ -145,18 +144,18 @@ toJS' (L span expr) =

145 Case e cases -> caseToJS span e cases

144 Case e cases -> caseToJS span e cases

146 _ -> toJS expr

145 _ -> toJS expr

147

146

148−remove x e = "_N.remove('" ++ deprime x ++ "', " ++ e ++ ")"

147+remove x e = "_N.remove('" ++ x ++ "', " ++ e ++ ")"

149−addField x v e = "_N.insert('" ++ deprime x ++ "', " ++ v ++ ", " ++ e ++ ")"

148+addField x v e = "_N.insert('" ++ x ++ "', " ++ v ++ ", " ++ e ++ ")"

150setField fs e = "_N.replace(" ++ jsList (map f fs) ++ ", " ++ e ++ ")"

149setField fs e = "_N.replace(" ++ jsList (map f fs) ++ ", " ++ e ++ ")"

151− where f (x,v) = "['" ++ deprime x ++ "'," ++ v ++ "]"

150+ where f (x,v) = "['" ++ x ++ "'," ++ v ++ "]"

152−access x e = e ++ "." ++ deprime x

151+access x e = e ++ "." ++ x

153makeRecord kvs = record `liftM` collect kvs

152makeRecord kvs = record `liftM` collect kvs

154 where

153 where

155 combine r (k,v) = Map.insertWith (++) k v r

154 combine r (k,v) = Map.insertWith (++) k v r

156 collect = liftM (List.foldl' combine Map.empty) . mapM prep

155 collect = liftM (List.foldl' combine Map.empty) . mapM prep

157 prep (k, e) =

156 prep (k, e) =

158 do v <- toJS' e

157 do v <- toJS' e

159− return (deprime k, [v])

158+ return (k, [v])

160 fields fs =

159 fields fs =

161 brackets ("\n "++List.intercalate ",\n " (map (\(k,v) -> k++":"++v) fs))

160 brackets ("\n "++List.intercalate ",\n " (map (\(k,v) -> k++":"++v) fs))

162 hidden = fields . map (second jsList) .

161 hidden = fields . map (second jsList) .

@@ -177,7 +176,7 @@ instance ToJS Literal where

177instance ToJS (Expr t v) where

176instance ToJS (Expr t v) where

178 toJS expr =

177 toJS expr =

179 case expr of

178 case expr of

180− Var x -> return (deprime x)

179+ Var x -> return x

181 Literal lit -> toJS lit

180 Literal lit -> toJS lit

182 Range lo hi -> jsRange `liftM` toJS' lo `ap` toJS' hi

181 Range lo hi -> jsRange `liftM` toJS' lo `ap` toJS' hi

183 Access e x -> access x `liftM` toJS' e

182 Access e x -> access x `liftM` toJS' e

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

200

199

201 depattern (pattern,n) (args, body) =

200 depattern (pattern,n) (args, body) =

202 case pattern of

201 case pattern of

203− PVar x -> (deprime x : args, body)

202+ PVar x -> (x : args, body)

204 _ -> let arg = "arg" ++ show n

203 _ -> let arg = "arg" ++ show n

205 in (arg:args, L s (Case (L s (Var arg)) [(pattern, body)]))

204 in (arg:args, L s (Case (L s (Var arg)) [(pattern, body)]))

206

205

@@ -268,7 +267,7 @@ caseToJS span e ps = do

268 (tempVar,match) <- caseToMatch ps

267 (tempVar,match) <- caseToMatch ps

269 e' <- toJS' e

268 e' <- toJS' e

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

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

271− L _ (Var x) -> (matchSubst [(tempVar,deprime x)] match, "")

270+ L _ (Var x) -> (matchSubst [(tempVar,x)] match, "")

272 _ -> (match, assign tempVar e')

271 _ -> (match, assign tempVar e')

273 matches <- matchToJS span match'

272 matches <- matchToJS span match'

274 return $ jsFunc "" (stmt ++ matches) ++ "()"

273 return $ jsFunc "" (stmt ++ matches) ++ "()"

compiler/Parse/Helpers.hs+4−1

@@ -49,10 +49,13 @@ rLabel = lowVar

49innerVarChar :: IParser Char

50innerVarChar = alphaNum <|> char '_' <|> char '\'' <?> ""

52+deprime :: String -> String

53+deprime = map (\c -> if c == '\'' then '$' else c)

54+

52makeVar :: IParser Char -> IParser String

55makeVar :: IParser Char -> IParser String

53makeVar p = do v <- (:) <$> p <*> many innerVarChar

56makeVar p = do v <- (:) <$> p <*> many innerVarChar

54 guard (v `notElem` reserveds)

57 guard (v `notElem` reserveds)

55− return v

58+ return (deprime v)

57reserved :: String -> IParser String

60reserved :: String -> IParser String

58reserved word =

61reserved word =