yogsototh/elm
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Cosmetic: import the prefixed version of Generate.Cases

Browse source
This commit is contained in:
Evan Czaplicki 2013-10-08 20:04:08 -07:00
parent 0b11d4f0bd
commit ea38376358
2 changed files with 18 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
compiler/Generate/Cases.hs
View file

@ -1,4 +1,4 @@
module Generate.Cases (caseToMatch, Match (..), Clause (..), matchSubst) where
module Generate.Cases (toMatch, Match (..), Clause (..), matchSubst) where
import Control.Applicative ((<$>),(<*>))
import Control.Arrow (first,second)
@ -13,8 +13,8 @@ import SourceSyntax.Expression
import Transform.Substitute
caseToMatch :: [(Pattern, LExpr t v)] -> State Int (String, Match t v)
caseToMatch patterns = do
toMatch :: [(Pattern, LExpr t v)] -> State Int (String, Match t v)
toMatch patterns = do
v <- newVar
(,) v <$> match [v] (map (first (:[])) patterns) Fail

27
compiler/Generate/JavaScript.hs
View file

@ -8,7 +8,7 @@ import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Text.Pandoc as Pan
import Generate.Cases
import qualified Generate.Cases as Case
import SourceSyntax.Everything
import SourceSyntax.Location
import qualified Transform.SortDefinitions as SD
@ -166,10 +166,10 @@ expression (L span expr) =
iff (if', then') else' = CondExpr () if' then' else'
Case e cases ->
do (tempVar,initialMatch) <- caseToMatch cases
do (tempVar,initialMatch) <- Case.toMatch cases
(revisedMatch, stmt) <-
case e of
L _ (Var x) -> return (matchSubst [(tempVar,x)] initialMatch, [])
L _ (Var x) -> return (Case.matchSubst [(tempVar,x)] initialMatch, [])
_ -> do e' <- expression e
return (initialMatch, [VarDeclStmt () [varDecl tempVar e']])
match' <- match span revisedMatch
@ -239,33 +239,36 @@ definition def =
toDef y = definition $
Def (PVar y) (L span $ Case (mkVar "$") [(pattern, mkVar y)])
match :: (Show a) => a -> Case.Match () () -> State Int [Statement ()]
match span mtch =
case mtch of
Match name clauses mtch' ->
Case.Match name clauses mtch' ->
do clauses' <- mapM (clause span name) clauses
mtch'' <- match span mtch'
return (SwitchStmt () (access name) clauses' : mtch'')
where
isLiteral p = case p of
Clause (Right _) _ _ -> True
Case.Clause (Right _) _ _ -> True
_ -> False
access name = if any isLiteral clauses then ref name else dotSep [name,"ctor"]
Fail -> return [ ExprStmt () (obj "_E.Case" `call` [ref "$moduleName", string (show span)]) ]
Break -> return []
Other e ->
Case.Fail ->
return [ ExprStmt () (obj "_E.Case" `call` [ref "$moduleName", string (show span)]) ]
Case.Break -> return []
Case.Other e ->
do e' <- expression e
return [ ReturnStmt () (Just e') ]
Seq ms -> concat <$> mapM (match span) (dropEnd [] ms)
Case.Seq ms -> concat <$> mapM (match span) (dropEnd [] ms)
where
dropEnd acc [] = acc
dropEnd acc (m:ms) =
case m of
Other _ -> acc ++ [m]
Case.Other _ -> acc ++ [m]
_ -> dropEnd (acc ++ [m]) ms
clause span variable (Clause value vars mtch) =
CaseClause () pattern <$> match span (matchSubst (zip vars vars') mtch)
clause span variable (Case.Clause value vars mtch) =
CaseClause () pattern <$> match span (Case.matchSubst (zip vars vars') mtch)
where
vars' = map (\n -> variable ++ "._" ++ show n) [0..]
pattern = case value of