diff options
author | AndreyChudnov <> | 2015-01-02 04:26:00 (GMT) |
---|---|---|
committer | hdiff <hdiff@hdiff.luite.com> | 2015-01-02 04:26:00 (GMT) |
commit | 1cf62f6c241cfdaba2ce77fb1443bc7abd8e18a3 (patch) | |
tree | 34adb342ca063c284ea74322f0624b921c244a77 | |
parent | ca8c15e0ff2623d8b9454071ad58662b23d955da (diff) |
version 0.170.17
-rw-r--r-- | CHANGELOG | 3 | ||||
-rw-r--r-- | LICENSE | 2 | ||||
-rw-r--r-- | language-ecmascript.cabal | 7 | ||||
-rw-r--r-- | src/Language/ECMAScript3/Syntax/Arbitrary.hs | 66 | ||||
-rw-r--r-- | src/Language/ECMAScript3/Syntax/CodeGen.hs | 386 |
5 files changed, 432 insertions, 32 deletions
@@ -1,5 +1,8 @@ Version change log. +=0.17= +Added helper functions for code generation (see Language.ECMAScript3.Syntax.CodeGen). Bug fixes to the Arbitrary instances. + =0.16.2= Build fixes for GHC 7.4.2 and 7.8.2. @@ -1,5 +1,5 @@ Copyright (c) 2007--2012, Brown University, 2008-2012 Claudiu Saftoiu, -2012-2014 Stevens Institute of Technology. +2012-2015 Stevens Institute of Technology. All Rights Reserved. Redistribution and use in source and binary forms, with or without diff --git a/language-ecmascript.cabal b/language-ecmascript.cabal index 1d99d61..21f28d0 100644 --- a/language-ecmascript.cabal +++ b/language-ecmascript.cabal @@ -1,8 +1,8 @@ Name: language-ecmascript -Version: 0.16.2 +Version: 0.17 Cabal-Version: >= 1.10 Copyright: (c) 2007-2012 Brown University, (c) 2008-2010 Claudiu Saftoiu, - (c) 2012-2014 Stevens Institute of Technology + (c) 2012-2015 Stevens Institute of Technology License: BSD3 License-file: LICENSE Author: Andrey Chudnov, Arjun Guha, Spiridon Aristides Eliopoulos, @@ -29,7 +29,7 @@ Source-repository head Source-repository this type: git location: git://github.com/jswebtools/language-ecmascript.git - tag: 0.16.2 + tag: 0.17 Library Hs-Source-Dirs: @@ -56,6 +56,7 @@ Library Language.ECMAScript3.Syntax Language.ECMAScript3.Syntax.Annotations Language.ECMAScript3.Syntax.Arbitrary + Language.ECMAScript3.Syntax.CodeGen Language.ECMAScript3.Syntax.QuasiQuote Language.ECMAScript3.Analysis.Environment Language.ECMAScript3.Analysis.LabelSets diff --git a/src/Language/ECMAScript3/Syntax/Arbitrary.hs b/src/Language/ECMAScript3/Syntax/Arbitrary.hs index 48c27a6..d48140c 100644 --- a/src/Language/ECMAScript3/Syntax/Arbitrary.hs +++ b/src/Language/ECMAScript3/Syntax/Arbitrary.hs @@ -22,6 +22,7 @@ import Test.Feat import Test.Feat.Class import Test.Feat.Enumerate import Test.Feat.Modifiers +import Control.Arrow deriveEnumerable ''AssignOp deriveEnumerable ''InfixOp @@ -179,15 +180,15 @@ class Fixable a where fixUp :: a -> Gen a instance (Data a) => Fixable (JavaScript a) where - fixUp (Script a ss) = (liftM (Script a) (fixBreakContinue ss)) - >>=transformBiM (return . identifierFixup - :: Id a -> Gen (Id a)) - >>=transformBiM (fixUpFunExpr + fixUp = transformBiM (return . identifierFixup + :: Id a -> Gen (Id a)) + >=>transformBiM (fixUpFunExpr :: Expression a -> Gen (Expression a)) - >>=transformBiM (fixUpFunStmt + >=>transformBiM (fixUpFunStmt :: Statement a -> Gen (Statement a)) - >>=transformBiM (return . fixLValue + >=>transformBiM (return . fixLValue :: LValue a -> Gen (LValue a)) + >=>(\(Script a ss)-> liftM (Script a) $ fixBreakContinue ss) instance (Data a) => Fixable (Expression a) where fixUp = (fixUpFunExpr . transformBi (identifierFixup :: Id a -> Id a)) @@ -298,27 +299,25 @@ fixBreakContinue = mapM $ \stmt -> evalStateT (fixBC stmt) ([], []) fixBC stmt@(LabelledStmt a lab s) = do labs <- gets fst if (unId lab) `elem` labs - -- if duplicate label, delete the current statement (but - -- keep it's child statement) - then descendM fixBC stmt - else liftM (LabelledStmt a lab) $ descendM fixBC s + -- if duplicate label, delete the current statement (but + -- keep it's child statement) + then descendM fixBC s + else pushLabel lab $ descendM fixBC stmt fixBC stmt@(BreakStmt a mlab) = do encls <- gets snd - case mlab of - Nothing -> if or $ map isIterSwitch encls then return stmt + case (mlab, encls) of + (_, []) -> return $ EmptyStmt a + (Nothing, _) -> if all isIterSwitch encls + then return stmt -- if none of the enclosing statements is an -- iteration or switch statement, substitute -- the break statement for an empty statement else return $ EmptyStmt a - Just lab@(Id b _) -> + (Just lab@(Id b _), _) -> if any (elem (unId lab) . getLabelSet) encls then return stmt - else if not $ and $ map isIterSwitch encls - -- if none of the enclosing statements is an - -- iteration or switch statement, substitute - -- the break statement for an empty statement - then return $ EmptyStmt a - else case concatMap getLabelSet encls of + else if all isIterSwitch encls + then case concatMap getLabelSet encls of -- if none of the enclosing statements have -- labels, remove the label from the break -- statement @@ -326,17 +325,21 @@ fixBreakContinue = mapM $ \stmt -> evalStateT (fixBC stmt) ([], []) -- if some of them have labels, add the first -- label to the break statement ls -> do newLab <- lift $ selectRandomElement ls - return $ BreakStmt a (Just $ Id b newLab) + return $ BreakStmt a $ Just $ Id b newLab + -- if none of the enclosing statements is an + -- iteration or switch statement, substitute + -- the break statement for an empty statement + else return $ EmptyStmt a fixBC stmt@(ContinueStmt a mlab) = do encls <- gets snd let enIts = filter isIter encls - case mlab of - Nothing -> if not $ null enIts then return stmt - -- if none of the enclosing statements are - -- iteration statements, substitute the - -- continue statement for an empty statement - else return $ EmptyStmt a - Just lab@(Id b _) -> + case (mlab, enIts) of + -- if none of the enclosing statements are + -- iteration statements, substitute the + -- continue statement for an empty statement + (_, []) -> return $ EmptyStmt a + (Nothing, _) -> return stmt + (Just lab@(Id b _), _) -> if any (elem (unId lab) . getLabelSet) enIts then return stmt else case concatMap getLabelSet enIts of @@ -353,7 +356,14 @@ fixBreakContinue = mapM $ \stmt -> evalStateT (fixBC stmt) ([], []) -- label to the break statement ls -> do newLab <- lift $ selectRandomElement ls return $ ContinueStmt a (Just $ Id b newLab) - fixBC s = descendM fixBC s + fixBC s@(WhileStmt {}) = iterCommon s + fixBC s@(DoWhileStmt {}) = iterCommon s + fixBC s@(ForStmt {}) = iterCommon s + fixBC s@(ForInStmt {}) = iterCommon s + fixBC s@(SwitchStmt {}) = pushEnclosing EnclosingSwitch $ descendM fixBC s + fixBC s@(BlockStmt {}) = pushEnclosing EnclosingOther $ descendM fixBC s + fixBC s = descendM fixBC s + iterCommon s = pushEnclosing EnclosingIter $ descendM fixBC s -- | choose n elements from a list randomly rChooseElem :: [a] -> Int -> Gen [a] diff --git a/src/Language/ECMAScript3/Syntax/CodeGen.hs b/src/Language/ECMAScript3/Syntax/CodeGen.hs new file mode 100644 index 0000000..01dc1c9 --- /dev/null +++ b/src/Language/ECMAScript3/Syntax/CodeGen.hs @@ -0,0 +1,386 @@ +{-# LANGUAGE NoMonomorphismRestriction #-} +-- | Utility combinator functions for simplifying writing programmatic +-- generation of ECMAScript code. Recommended to use together with the +-- -XOverloadedStrings GHC extension. +module Language.ECMAScript3.Syntax.CodeGen where + +import Language.ECMAScript3.Syntax +import Data.Default.Class +import Data.String + +script :: Default a => [Statement a] -> JavaScript a +script = Script def + +instance Default a => IsString (Id a) where + fromString = Id def + +instance Default a => IsString (Prop a) where + fromString = PropString def + +ident :: Default a => String -> Id a +ident = Id def + +propId :: Default a => Id a -> Prop a +propId = PropId def + +propS :: Default a => String -> Prop a +propS = PropString def + +propN :: Default a => Integer -> Prop a +propN = PropNum def + +instance Default a => IsString (LValue a) where + fromString = LVar def + +lvar :: Default a => String -> LValue a +lvar = LVar def + +ldot :: Default a => Expression a -> String -> LValue a +ldot = LDot def + +lbrack :: Default a => Expression a -> Expression a -> LValue a +lbrack = LBracket def + +instance Default a => IsString (Expression a) where + fromString = StringLit def + +string :: Default a => String -> Expression a +string = StringLit def + +regexp :: Default a => String -> Bool -> Bool -> Expression a +regexp = RegexpLit def + +number :: Default a => Double -> Expression a +number = NumLit def + +bool :: Default a => Bool -> Expression a +bool = BoolLit def + +int :: Default a => Int -> Expression a +int = IntLit def + +null_ :: Default a => Expression a +null_ = NullLit def + +array :: Default a => [Expression a] -> Expression a +array = ArrayLit def + +object :: Default a => [(Prop a, Expression a)] -> Expression a +object = ObjectLit def + +this :: Default a => Expression a +this = ThisRef def + +var :: Default a => Id a -> Expression a +var = VarRef def + +dot :: Default a => Expression a -> Id a -> Expression a +dot = DotRef def + +brack :: Default a => Expression a -> Expression a -> Expression a +brack = BracketRef def + +new :: Default a => Expression a -> [Expression a] -> Expression a +new = NewExpr def + +prefix :: Default a => PrefixOp -> Expression a -> Expression a +prefix = PrefixExpr def + +lnot :: Default a => Expression a -> Expression a +lnot = prefix PrefixLNot + +bnot :: Default a => Expression a -> Expression a +bnot = prefix PrefixBNot + +plus :: Default a => Expression a -> Expression a +plus = prefix PrefixPlus + +minus :: Default a => Expression a -> Expression a +minus = prefix PrefixMinus + +typeof :: Default a => Expression a -> Expression a +typeof = prefix PrefixTypeof + +void :: Default a => Expression a -> Expression a +void = prefix PrefixVoid + +delete :: Default a => Expression a -> Expression a +delete = prefix PrefixDelete + +uassign :: Default a => UnaryAssignOp -> LValue a -> Expression a +uassign = UnaryAssignExpr def + +preinc :: Default a => LValue a -> Expression a +preinc = uassign PrefixInc + +predec :: Default a => LValue a -> Expression a +predec = uassign PrefixDec + +postinc :: Default a => LValue a -> Expression a +postinc = uassign PostfixInc + +postdec :: Default a => LValue a -> Expression a +postdec = uassign PostfixDec + +infixe + :: Default a => + InfixOp -> Expression a -> Expression a -> Expression a +infixe = InfixExpr def + +lt :: Default a => Expression a -> Expression a -> Expression a +lt = infixe OpLT + +le :: Default a => Expression a -> Expression a -> Expression a +le = infixe OpLEq + +gt :: Default a => Expression a -> Expression a -> Expression a +gt = infixe OpGT + +ge :: Default a => Expression a -> Expression a -> Expression a +ge = infixe OpGEq + +in_ :: Default a => Expression a -> Expression a -> Expression a +in_= infixe OpIn + +instanceof + :: Default a => Expression a -> Expression a -> Expression a +instanceof = infixe OpInstanceof + +eq :: Default a => Expression a -> Expression a -> Expression a +eq = infixe OpEq + +neq :: Default a => Expression a -> Expression a -> Expression a +neq = infixe OpNEq + +steq :: Default a => Expression a -> Expression a -> Expression a +steq = infixe OpStrictEq + +stneq :: Default a => Expression a -> Expression a -> Expression a +stneq = infixe OpStrictNEq + +land :: Default a => Expression a -> Expression a -> Expression a +land = infixe OpLAnd + +lor :: Default a => Expression a -> Expression a -> Expression a +lor = infixe OpLOr + +mul :: Default a => Expression a -> Expression a -> Expression a +mul = infixe OpMul + +div :: Default a => Expression a -> Expression a -> Expression a +div = infixe OpDiv + +mod :: Default a => Expression a -> Expression a -> Expression a +mod = infixe OpMod + +sub :: Default a => Expression a -> Expression a -> Expression a +sub = infixe OpSub + +lshift :: Default a => Expression a -> Expression a -> Expression a +lshift = infixe OpLShift + +srshift + :: Default a => Expression a -> Expression a -> Expression a +srshift = infixe OpSpRShift + +zrshift + :: Default a => Expression a -> Expression a -> Expression a +zrshift = infixe OpZfRShift + +band :: Default a => Expression a -> Expression a -> Expression a +band = infixe OpBAnd + +bor :: Default a => Expression a -> Expression a -> Expression a +bor = infixe OpBOr + +xor :: Default a => Expression a -> Expression a -> Expression a +xor = infixe OpBXor + +add :: Default a => Expression a -> Expression a -> Expression a +add = infixe OpAdd + +cond + :: Default a => + Expression a -> Expression a -> Expression a -> Expression a +cond = CondExpr def + +assignop :: Default a => AssignOp -> LValue a -> Expression a -> Expression a +assignop = AssignExpr def + +assign + :: Default a => LValue a -> Expression a -> Expression a +assign = assignop OpAssign + +assignadd :: Default a => LValue a -> Expression a -> Expression a +assignadd = assignop OpAssignAdd + +assignsub :: Default a => LValue a -> Expression a -> Expression a +assignsub = assignop OpAssignSub + +assignmul :: Default a => LValue a -> Expression a -> Expression a +assignmul = assignop OpAssignMul + +assigndiv :: Default a => LValue a -> Expression a -> Expression a +assigndiv = assignop OpAssignDiv + +assignmod :: Default a => LValue a -> Expression a -> Expression a +assignmod = assignop OpAssignMod + +assignlshift + :: Default a => LValue a -> Expression a -> Expression a +assignlshift = assignop OpAssignLShift + +assignsrshift + :: Default a => LValue a -> Expression a -> Expression a +assignsrshift = assignop OpAssignSpRShift + +assignzrshift + :: Default a => LValue a -> Expression a -> Expression a +assignzrshift = assignop OpAssignZfRShift + +assignband :: Default a => LValue a -> Expression a -> Expression a +assignband = assignop OpAssignBAnd + +assignxor :: Default a => LValue a -> Expression a -> Expression a +assignxor = assignop OpAssignBXor + +assignbor :: Default a => LValue a -> Expression a -> Expression a +assignbor = assignop OpAssignBOr + +list :: Default a => [Expression a] -> Expression a +list = ListExpr def + +call :: Default a => Expression a -> [Expression a] -> Expression a +call = CallExpr def + +func + :: Default a => Id a -> [Id a] -> [Statement a] -> Expression a +func id = FuncExpr def (Just id) + +lambda :: Default a => [Id a] -> [Statement a] -> Expression a +lambda = FuncExpr def Nothing + +casee :: Default a => Expression a -> [Statement a] -> CaseClause a +casee = CaseClause def + +defaultc :: Default a => [Statement a] -> CaseClause a +defaultc = CaseDefault def + +catch :: Default a => Id a -> Statement a -> CatchClause a +catch = CatchClause def + +vardecl :: Default a => Id a -> VarDecl a +vardecl id = VarDecl def id Nothing + +varinit :: Default a => Id a -> Expression a -> VarDecl a +varinit id = VarDecl def id . Just + +block :: Default a => [Statement a] -> Statement a +block = BlockStmt def + +empty :: Default a => Statement a +empty = EmptyStmt def + +expr :: Default a => Expression a -> Statement a +expr = ExprStmt def + +ifte + :: Default a => + Expression a -> Statement a -> Statement a -> Statement a +ifte = IfStmt def + +ift :: Default a => Expression a -> Statement a -> Statement a +ift = IfSingleStmt def + +switch + :: Default a => Expression a -> [CaseClause a] -> Statement a +switch = SwitchStmt def + +while :: Default a => Expression a -> Statement a -> Statement a +while = WhileStmt def + +dowhile :: Default a => Statement a -> Expression a -> Statement a +dowhile = DoWhileStmt def + +break :: Default a => Maybe (Id a) -> Statement a +break = BreakStmt def + +continue :: Default a => Maybe (Id a) -> Statement a +continue = ContinueStmt def + +label :: Default a => Id a -> Statement a -> Statement a +label = LabelledStmt def + +forin + :: Default a => + ForInInit a -> Expression a -> Statement a -> Statement a +forin = ForInStmt def + +for + :: Default a => + ForInit a + -> Maybe (Expression a) + -> Maybe (Expression a) + -> Statement a + -> Statement a +for = ForStmt def + +try :: Default a => Statement a -> Statement a +try b = TryStmt def b Nothing Nothing + +trycatch + :: Default a => + Statement a -> CatchClause a -> Maybe (Statement a) -> Statement a +trycatch b c = TryStmt def b (Just c) + +tryfinally + :: Default a => Statement a -> Statement a -> Statement a +tryfinally b f = TryStmt def b Nothing (Just f) + +trycatchfinally + :: Default a => + Statement a -> CatchClause a -> Statement a -> Statement a +trycatchfinally b c f = TryStmt def b (Just c) (Just f) + +throw :: Default a => Expression a -> Statement a +throw = ThrowStmt def + +returns :: Default a => Expression a -> Statement a +returns = ReturnStmt def . Just + +ret :: Default a => Statement a +ret = ReturnStmt def Nothing + +with :: Default a => Expression a -> Statement a -> Statement a +with = WithStmt def + +vardecls :: Default a => [VarDecl a] -> Statement a +vardecls = VarDeclStmt def + +function + :: Default a => Id a -> [Id a] -> [Statement a] -> Statement a +function = FunctionStmt def + +-- | Convert an identifier to a String literal +id2string :: Id a -> Expression a +id2string (Id a s) = StringLit a s + +-- | Helper function to convert LValues to expressions +lv2e :: LValue a -> Expression a +lv2e lval = case lval of + LVar a vname -> VarRef a (Id a vname) + LDot a obj fname -> DotRef a obj (Id a fname) + LBracket a obj field -> BracketRef a obj field + +-- | Convert an expression to an l-value. May fail with an error +e2lv :: Expression a -> LValue a +e2lv e = case e of + VarRef a (Id _ vname) -> LVar a vname + DotRef a obj (Id _ fname) -> LDot a obj fname + BracketRef a obj field -> LBracket a obj field + _ -> error "expr2LVal: Can't convert an expression to an LValue" + +forInInit2lv :: ForInInit a -> LValue a +forInInit2lv i = case i of + ForInVar (Id a s) -> LVar a s + ForInLVal lv -> lv |