{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingVia #-} {-# LANGUAGE BlockArguments #-} {-# LANGUAGE PatternSynonyms #-} ----------------------------------------------------------------------------- -- | -- Module : GHC.JS.Syntax -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file LICENSE) -- -- Maintainer : Jeffrey Young -- Luite Stegeman -- Sylvain Henry -- Josh Meredith -- Stability : experimental -- -- -- * Domain and Purpose -- -- GHC.JS.Syntax defines the Syntax for the JS backend in GHC. It comports -- with the [ECMA-262](https://tc39.es/ecma262/) although not every -- production rule of the standard is represented. Code in this module is a -- fork of [JMacro](https://hackage.haskell.org/package/jmacro) (BSD 3 -- Clause) by Gershom Bazerman, heavily modified to accomodate GHC's -- constraints. -- -- -- * Strategy -- -- Nothing fancy in this module, this is a classic deeply embeded AST for -- JS. We define numerous ADTs and pattern synonyms to make pattern matching -- and constructing ASTs easier. -- -- -- * Consumers -- -- The entire JS backend consumes this module, e.g., the modules in -- GHC.StgToJS.\*. Please see 'GHC.JS.Make' for a module which provides -- helper functions that use the deeply embedded DSL defined in this module -- to provide some of the benefits of a shallow embedding. ----------------------------------------------------------------------------- module GHC.JS.Syntax ( -- * Deeply embedded JS datatypes JStat(..) , JExpr(..) , JVal(..) , JOp(..) , JUOp(..) , Ident(..) , identFS , JsLabel -- * pattern synonyms over JS operators , pattern New , pattern Not , pattern Negate , pattern Add , pattern Sub , pattern Mul , pattern Div , pattern Mod , pattern BOr , pattern BAnd , pattern BXor , pattern BNot , pattern LOr , pattern LAnd , pattern Int , pattern String , pattern PreInc , pattern PostInc , pattern PreDec , pattern PostDec -- * Ident supply , IdentSupply(..) , newIdentSupply , pseudoSaturate -- * Utility , SaneDouble(..) ) where import GHC.Prelude import Control.DeepSeq import Data.Function import Data.Data import Data.Word import qualified Data.Semigroup as Semigroup import GHC.Generics import GHC.Data.FastString import GHC.Utils.Monad.State.Strict import GHC.Types.Unique import GHC.Types.Unique.Map -- | A supply of identifiers, possibly empty newtype IdentSupply a = IS {runIdentSupply :: State [Ident] a} deriving Typeable instance NFData (IdentSupply a) where rnf IS{} = () inIdentSupply :: (State [Ident] a -> State [Ident] b) -> IdentSupply a -> IdentSupply b inIdentSupply f x = IS $ f (runIdentSupply x) instance Functor IdentSupply where fmap f x = inIdentSupply (fmap f) x newIdentSupply :: Maybe FastString -> [Ident] newIdentSupply Nothing = newIdentSupply (Just "jmId") newIdentSupply (Just pfx) = [ TxtI (mconcat [pfx,"_",mkFastString (show x)]) | x <- [(0::Word64)..] ] -- | Given a Pseudo-saturate a value with garbage @<>@ identifiers. pseudoSaturate :: IdentSupply a -> a pseudoSaturate x = evalState (runIdentSupply x) $ newIdentSupply (Just "<>") instance Eq a => Eq (IdentSupply a) where (==) = (==) `on` pseudoSaturate instance Ord a => Ord (IdentSupply a) where compare = compare `on` pseudoSaturate instance Show a => Show (IdentSupply a) where show x = "(" ++ show (pseudoSaturate x) ++ ")" -------------------------------------------------------------------------------- -- Statements -------------------------------------------------------------------------------- -- | JavaScript statements, see the [ECMA262 -- Reference](https://tc39.es/ecma262/#sec-ecmascript-language-statements-and-declarations) -- for details data JStat = DeclStat !Ident !(Maybe JExpr) -- ^ Variable declarations: var foo [= e] | ReturnStat JExpr -- ^ Return | IfStat JExpr JStat JStat -- ^ If | WhileStat Bool JExpr JStat -- ^ While, bool is "do" when True | ForInStat Bool Ident JExpr JStat -- ^ For-in, bool is "each' when True | SwitchStat JExpr [(JExpr, JStat)] JStat -- ^ Switch | TryStat JStat Ident JStat JStat -- ^ Try | BlockStat [JStat] -- ^ Blocks | ApplStat JExpr [JExpr] -- ^ Application | UOpStat JUOp JExpr -- ^ Unary operators | AssignStat JExpr JExpr -- ^ Binding form: @foo = bar@ | UnsatBlock (IdentSupply JStat) -- ^ /Unsaturated/ blocks see 'pseudoSaturate' | LabelStat JsLabel JStat -- ^ Statement Labels, makes me nostalgic for qbasic | BreakStat (Maybe JsLabel) -- ^ Break | ContinueStat (Maybe JsLabel) -- ^ Continue deriving (Eq, Typeable, Generic) -- | A Label used for 'JStat', specifically 'BreakStat', 'ContinueStat' and of -- course 'LabelStat' type JsLabel = LexicalFastString instance Semigroup JStat where (<>) = appendJStat instance Monoid JStat where mempty = BlockStat [] -- | Append a statement to another statement. 'appendJStat' only returns a -- 'JStat' that is /not/ a 'BlockStat' when either @mx@ or @my is an empty -- 'BlockStat'. That is: -- > (BlockStat [] , y ) = y -- > (x , BlockStat []) = x appendJStat :: JStat -> JStat -> JStat appendJStat mx my = case (mx,my) of (BlockStat [] , y ) -> y (x , BlockStat []) -> x (BlockStat xs , BlockStat ys) -> BlockStat $ xs ++ ys (BlockStat xs , ys ) -> BlockStat $ xs ++ [ys] (xs , BlockStat ys) -> BlockStat $ xs : ys (xs , ys ) -> BlockStat [xs,ys] -------------------------------------------------------------------------------- -- Expressions -------------------------------------------------------------------------------- -- | JavaScript Expressions data JExpr = ValExpr JVal -- ^ All values are trivially expressions | SelExpr JExpr Ident -- ^ Selection: Obj.foo, see 'GHC.JS.Make..^' | IdxExpr JExpr JExpr -- ^ Indexing: Obj[foo], see 'GHC.JS.Make..!' | InfixExpr JOp JExpr JExpr -- ^ Infix Expressions, see 'JExpr' -- pattern synonyms | UOpExpr JUOp JExpr -- ^ Unary Expressions | IfExpr JExpr JExpr JExpr -- ^ If-expression | ApplExpr JExpr [JExpr] -- ^ Application | UnsatExpr (IdentSupply JExpr) -- ^ An /Unsaturated/ expression. -- See 'pseudoSaturate' deriving (Eq, Typeable, Generic) -- * Useful pattern synonyms to ease programming with the deeply embedded JS -- AST. Each pattern wraps @JUOp@ and @JOp@ into a @JExpr@s to save typing and -- for convienience. In addition we include a string wrapper for JS string -- and Integer literals. -- | pattern synonym for a unary operator new pattern New :: JExpr -> JExpr pattern New x = UOpExpr NewOp x -- | pattern synonym for prefix increment @++x@ pattern PreInc :: JExpr -> JExpr pattern PreInc x = UOpExpr PreIncOp x -- | pattern synonym for postfix increment @x++@ pattern PostInc :: JExpr -> JExpr pattern PostInc x = UOpExpr PostIncOp x -- | pattern synonym for prefix decrement @--x@ pattern PreDec :: JExpr -> JExpr pattern PreDec x = UOpExpr PreDecOp x -- | pattern synonym for postfix decrement @--x@ pattern PostDec :: JExpr -> JExpr pattern PostDec x = UOpExpr PostDecOp x -- | pattern synonym for logical not @!@ pattern Not :: JExpr -> JExpr pattern Not x = UOpExpr NotOp x -- | pattern synonym for unary negation @-@ pattern Negate :: JExpr -> JExpr pattern Negate x = UOpExpr NegOp x -- | pattern synonym for addition @+@ pattern Add :: JExpr -> JExpr -> JExpr pattern Add x y = InfixExpr AddOp x y -- | pattern synonym for subtraction @-@ pattern Sub :: JExpr -> JExpr -> JExpr pattern Sub x y = InfixExpr SubOp x y -- | pattern synonym for multiplication @*@ pattern Mul :: JExpr -> JExpr -> JExpr pattern Mul x y = InfixExpr MulOp x y -- | pattern synonym for division @*@ pattern Div :: JExpr -> JExpr -> JExpr pattern Div x y = InfixExpr DivOp x y -- | pattern synonym for remainder @%@ pattern Mod :: JExpr -> JExpr -> JExpr pattern Mod x y = InfixExpr ModOp x y -- | pattern synonym for Bitwise Or @|@ pattern BOr :: JExpr -> JExpr -> JExpr pattern BOr x y = InfixExpr BOrOp x y -- | pattern synonym for Bitwise And @&@ pattern BAnd :: JExpr -> JExpr -> JExpr pattern BAnd x y = InfixExpr BAndOp x y -- | pattern synonym for Bitwise XOr @^@ pattern BXor :: JExpr -> JExpr -> JExpr pattern BXor x y = InfixExpr BXorOp x y -- | pattern synonym for Bitwise Not @~@ pattern BNot :: JExpr -> JExpr pattern BNot x = UOpExpr BNotOp x -- | pattern synonym for logical Or @||@ pattern LOr :: JExpr -> JExpr -> JExpr pattern LOr x y = InfixExpr LOrOp x y -- | pattern synonym for logical And @&&@ pattern LAnd :: JExpr -> JExpr -> JExpr pattern LAnd x y = InfixExpr LAndOp x y -- | pattern synonym to create integer values pattern Int :: Integer -> JExpr pattern Int x = ValExpr (JInt x) -- | pattern synonym to create string values pattern String :: FastString -> JExpr pattern String x = ValExpr (JStr x) -------------------------------------------------------------------------------- -- Values -------------------------------------------------------------------------------- -- | JavaScript values data JVal = JVar Ident -- ^ A variable reference | JList [JExpr] -- ^ A JavaScript list, or what JS -- calls an Array | JDouble SaneDouble -- ^ A Double | JInt Integer -- ^ A BigInt | JStr FastString -- ^ A String | JRegEx FastString -- ^ A Regex | JHash (UniqMap FastString JExpr) -- ^ A JS HashMap: @{"foo": 0}@ | JFunc [Ident] JStat -- ^ A function | UnsatVal (IdentSupply JVal) -- ^ An /Unsaturated/ value, see 'pseudoSaturate' deriving (Eq, Typeable, Generic) -------------------------------------------------------------------------------- -- Operators -------------------------------------------------------------------------------- -- | JS Binary Operators. We do not deeply embed the comma operator and the -- assignment operators data JOp = EqOp -- ^ Equality: `==` | StrictEqOp -- ^ Strict Equality: `===` | NeqOp -- ^ InEquality: `!=` | StrictNeqOp -- ^ Strict InEquality `!==` | GtOp -- ^ Greater Than: `>` | GeOp -- ^ Greater Than or Equal: `>=` | LtOp -- ^ Less Than: < | LeOp -- ^ Less Than or Equal: <= | AddOp -- ^ Addition: + | SubOp -- ^ Subtraction: - | MulOp -- ^ Multiplication \* | DivOp -- ^ Division: \/ | ModOp -- ^ Remainder: % | LeftShiftOp -- ^ Left Shift: \<\< | RightShiftOp -- ^ Right Shift: \>\> | ZRightShiftOp -- ^ Unsigned RightShift: \>\>\> | BAndOp -- ^ Bitwise And: & | BOrOp -- ^ Bitwise Or: | | BXorOp -- ^ Bitwise XOr: ^ | LAndOp -- ^ Logical And: && | LOrOp -- ^ Logical Or: || | InstanceofOp -- ^ @instanceof@ | InOp -- ^ @in@ deriving (Show, Eq, Ord, Enum, Data, Typeable, Generic) instance NFData JOp -- | JS Unary Operators data JUOp = NotOp -- ^ Logical Not: @!@ | BNotOp -- ^ Bitwise Not: @~@ | NegOp -- ^ Negation: @-@ | PlusOp -- ^ Unary Plus: @+x@ | NewOp -- ^ new x | TypeofOp -- ^ typeof x | DeleteOp -- ^ delete x | YieldOp -- ^ yield x | VoidOp -- ^ void x | PreIncOp -- ^ Prefix Increment: @++x@ | PostIncOp -- ^ Postfix Increment: @x++@ | PreDecOp -- ^ Prefix Decrement: @--x@ | PostDecOp -- ^ Postfix Decrement: @x--@ deriving (Show, Eq, Ord, Enum, Data, Typeable, Generic) instance NFData JUOp -- | A newtype wrapper around 'Double' to ensure we never generate a 'Double' -- that becomes a 'NaN', see 'Eq SaneDouble', 'Ord SaneDouble' for details on -- Sane-ness newtype SaneDouble = SaneDouble { unSaneDouble :: Double } deriving (Data, Typeable, Fractional, Num, Generic, NFData) instance Eq SaneDouble where (SaneDouble x) == (SaneDouble y) = x == y || (isNaN x && isNaN y) instance Ord SaneDouble where compare (SaneDouble x) (SaneDouble y) = compare (fromNaN x) (fromNaN y) where fromNaN z | isNaN z = Nothing | otherwise = Just z instance Show SaneDouble where show (SaneDouble x) = show x -------------------------------------------------------------------------------- -- Identifiers -------------------------------------------------------------------------------- -- We use FastString for identifiers in JS backend -- | A newtype wrapper around 'FastString' for JS identifiers. newtype Ident = TxtI { itxt :: FastString } deriving stock (Show, Eq) deriving newtype (Uniquable) identFS :: Ident -> FastString identFS = \case TxtI fs -> fs