summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndreyChudnov <>2015-01-02 04:26:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2015-01-02 04:26:00 (GMT)
commit1cf62f6c241cfdaba2ce77fb1443bc7abd8e18a3 (patch)
tree34adb342ca063c284ea74322f0624b921c244a77
parentca8c15e0ff2623d8b9454071ad58662b23d955da (diff)
version 0.170.17
-rw-r--r--CHANGELOG3
-rw-r--r--LICENSE2
-rw-r--r--language-ecmascript.cabal7
-rw-r--r--src/Language/ECMAScript3/Syntax/Arbitrary.hs66
-rw-r--r--src/Language/ECMAScript3/Syntax/CodeGen.hs386
5 files changed, 432 insertions, 32 deletions
diff --git a/CHANGELOG b/CHANGELOG
index 36ecb7d..a9973f0 100644
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -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.
diff --git a/LICENSE b/LICENSE
index 31c5c13..7369370 100644
--- a/LICENSE
+++ b/LICENSE
@@ -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