HJavaScript 0.4.4 → 0.4.5
raw patch · 2 files changed
+199/−88 lines, 2 filesdep +prettydep ~basePVP ok
version bump matches the API change (PVP)
Dependencies added: pretty
Dependency ranges changed: base
API changes (from Hackage documentation)
+ Language.HJavaScript.Syntax: renderBlock :: Block r -> String
Files
- HJavaScript.cabal +2/−2
- src/Language/HJavaScript/Syntax.hs +197/−86
HJavaScript.cabal view
@@ -1,5 +1,5 @@ Name: HJavaScript-Version: 0.4.4+Version: 0.4.5 License: BSD3 Author: Joel Bjornson, Niklas Broberg Maintainer: joel.bjornson@gmail.com, nibro@cs.chalmers.se@@ -16,6 +16,6 @@ Hs-Source-Dirs: src Exposed-Modules: Language.HJavaScript.Syntax -Build-Depends: base+Build-Depends: base <5, pretty >= 1.0 Build-Type: Simple Category: Language
src/Language/HJavaScript/Syntax.hs view
@@ -1,14 +1,16 @@-{-# OPTIONS_GHC -fglasgow-exts #-}-{-# OPTIONS_GHC -fallow-overlapping-instances #-} -{-# OPTIONS_GHC -fallow-undecidable-instances #-}------------------------------------------------------------------------------ --- | --- Module : Language.HJavaScript.Syntax --- Copyright : (c) Joel Bjornson 2008 --- License : BSD-style +{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, + OverlappingInstances, UndecidableInstances, + Rank2Types, GADTs, EmptyDataDecls,+ FlexibleContexts, FlexibleInstances,+ TypeSynonymInstances #-}+-----------------------------------------------------------------------------+-- |+-- Module : Language.HJavaScript.Syntax+-- Copyright : (c) Joel Bjornson 2008+-- License : BSD-style -- Maintainer : Joel Bjornson joel.bjornson@gmail.com--- Niklas Broberg nibro@cs.chalmers.se --- Stability : experimental +-- Niklas Broberg nibro@cs.chalmers.se+-- Stability : experimental ----------------------------------------------------------------------------- module Language.HJavaScript.Syntax (@@ -17,7 +19,7 @@ -- * Fundamental data types. Exp(..),- Rec, + Rec, Var(..), Stmt(..), Block(..),@@ -41,7 +43,7 @@ Args, ParamType, FormalParams(..),- VarsToExps(..), + VarsToExps(..), -- * Array representation. Array(..),@@ -55,14 +57,18 @@ IsJBool(..), IsJInt(..), IsJFloat(..),- + -- * Helper functions val, toBlock, deref, derefVar, call, methodCall, voidMethodCall, - methodCallNoArgs, voidMethodCallNoArgs+ methodCallNoArgs, voidMethodCallNoArgs,++ -- * Render function producing multi-line pretty-printed JavaScript code.+ renderBlock, ) where +import Text.PrettyPrint.HughesPJ import Data.Char import Data.Maybe @@ -79,37 +85,37 @@ ------------------------------------------------------------------- -- JavaScript variable and expression representation -------------------------------------------------------------------- --- Var represents JavaScript variables. -data Var t where - JVar :: String -> Var a - JParam :: String -> Var a - JMember :: String -> Var a - JDerefVar :: IsDeref d => d -> String -> Var a - JArrayIndex :: Exp (Array t) -> Exp Int -> Var t - -instance Show (Var t) where - showsPrec p var = case var of - JVar v -> showString v - JParam name -> showString name - JMember s -> showString s - JDerefVar o v -> shows o . sDot . showString v - JArrayIndex a ix -> shows a . showString "[" . - shows ix . showString "]" - - --- We model records simply as tuples, for lack of a better record mechanism -data Rec a b +-- Var represents JavaScript variables.+data Var t where+ JVar :: String -> Var a+ JParam :: String -> Var a+ JMember :: String -> Var a+ JDerefVar :: IsDeref d => d -> String -> Var a+ JArrayIndex :: Exp (Array t) -> Exp Int -> Var t++instance Show (Var t) where+ showsPrec p var = case var of+ JVar v -> showString v+ JParam name -> showString name+ JMember s -> showString s+ JDerefVar o v -> shows o . sDot . showString v+ JArrayIndex a ix -> shows a . showString "[" . + shows ix . showString "]"+++-- We model records simply as tuples, for lack of a better record mechanism+data Rec a b+ -- Exp represents JavaScript Expressions. data Exp t where JInt :: Int -> Exp Int JFloat :: Float -> Exp Float JBool :: Bool -> Exp Bool JString :: String -> Exp String- JRec :: Exp a -> Exp b -> Exp (Rec a b) - JFst :: Exp (Rec a b) -> Exp a - JSnd :: Exp (Rec a b) -> Exp b + JRec :: Exp a -> Exp b -> Exp (Rec a b)+ JFst :: Exp (Rec a b) -> Exp a+ JSnd :: Exp (Rec a b) -> Exp b JConst :: String -> Exp t JAssign :: Var t -> Exp t -> Exp t JAssignWith :: Var t -> AssignOp t -> Exp t -> Exp t@@ -144,10 +150,10 @@ else showString "false" JString s -> sJtr s- JRec e1 e2 -> showString "{fst:" . shows e1 . showString "," . - showString "snd:" . shows e2 . showString "}" - JFst e -> shows e . showString ".fst" - JSnd e -> shows e . showString ".snd" + JRec e1 e2 -> showString "{fst:" . shows e1 . showString "," .+ showString "snd:" . shows e2 . showString "}"+ JFst e -> shows e . showString ".fst"+ JSnd e -> shows e . showString ".snd" JConst c -> showString c JAssign e1 e2 -> shows e1 . sEq . shows e2 JAssignWith e1 op e2 -> shows e1 . shows op . shows e2@@ -176,7 +182,7 @@ JBlock b -> shows b JNull -> showString "null" JIsImpl ob c -> shows ob . sDot . showsFeature c- JValueOf v -> shows v + JValueOf v -> shows v JCastObject e -> shows e JShow e -> shows e @@ -215,23 +221,23 @@ -- | Class that represents showable types class JShow a where- jshow :: a -> JString - + jshow :: a -> JString+ instance JShow Int where- jshow = jshow . JInt - + jshow = jshow . JInt+ instance JShow Float where- jshow = jshow . JFloat - + jshow = jshow . JFloat+ instance JShow Bool where- jshow = jshow . JBool - -instance JShow String where - jshow = JString - -instance JShow a => JShow (Exp a) where - jshow = JShow - + jshow = jshow . JBool+ +instance JShow String where+ jshow = JString++instance JShow a => JShow (Exp a) where+ jshow = JShow+ -- | Allows values to be compared to JNull. E.g. for checking that -- an object is instantiated or is accessible. class IsNullable a@@ -239,7 +245,7 @@ -- | All JString values along with all objects and all functions can be null. instance IsNullable String instance IsClass c => IsNullable c-instance IsNullable (t -> r) +instance IsNullable (t -> r) ------------------------------------------------------------------- -- JavaScript statements representation@@ -434,7 +440,7 @@ -- JavaScript functions. class Show e => Args e t | e -> t where showsArgs :: e -> ShowS- + instance Args () () where showsArgs = shows @@ -453,28 +459,28 @@ instance Args (Exp t1, Exp t2, Exp t3, Exp t4, Exp t5) (t1,t2,t3,t4,t5) where showsArgs = shows - -class VarsToExps v e | v -> e, e -> v where - v2e :: v -> e - -instance VarsToExps () () where - v2e = id - -instance VarsToExps (Var t) (Exp t) where - v2e = val - -instance VarsToExps (Var t1, Var t2) (Exp t1, Exp t2) where - v2e (v1,v2) = (val v1,val v2) -instance VarsToExps (Var t1, Var t2, Var t3) (Exp t1, Exp t2, Exp t3) where - v2e (v1,v2,v3) = (val v1,val v2,val v3) +class VarsToExps v e | v -> e, e -> v where+ v2e :: v -> e -instance VarsToExps (Var t1, Var t2, Var t3, Var t4) (Exp t1, Exp t2, Exp t3, Exp t4) where - v2e (v1,v2,v3,v4) = (val v1,val v2,val v3,val v4) - -instance VarsToExps (Var t1, Var t2, Var t3, Var t4, Var t5) (Exp t1, Exp t2, Exp t3, Exp t4, Exp t5) where - v2e (v1,v2,v3,v4,v5) = (val v1,val v2,val v3,val v4,val v5) - +instance VarsToExps () () where+ v2e = id++instance VarsToExps (Var t) (Exp t) where+ v2e = val++instance VarsToExps (Var t1, Var t2) (Exp t1, Exp t2) where+ v2e (v1,v2) = (val v1,val v2)++instance VarsToExps (Var t1, Var t2, Var t3) (Exp t1, Exp t2, Exp t3) where+ v2e (v1,v2,v3) = (val v1,val v2,val v3)++instance VarsToExps (Var t1, Var t2, Var t3, Var t4) (Exp t1, Exp t2, Exp t3, Exp t4) where+ v2e (v1,v2,v3,v4) = (val v1,val v2,val v3,val v4)++instance VarsToExps (Var t1, Var t2, Var t3, Var t4, Var t5) (Exp t1, Exp t2, Exp t3, Exp t4, Exp t5) where+ v2e (v1,v2,v3,v4,v5) = (val v1,val v2,val v3,val v4,val v5)+ -------------------------------------------------------------------- -- Object representation -------------------------------------------------------------------@@ -560,9 +566,9 @@ -- Dereferencing deref str obj = JDeref obj str- -derefVar str obj = JDerefVar obj str +derefVar str obj = JDerefVar obj str+ -- Calling a function call :: (Args e t) => Exp (t -> r) -> e -> Exp r call = JCall@@ -589,8 +595,113 @@ -- | Generates a Block from a Stmt. toBlock :: Stmt t -> Block t toBlock stm = Sequence EmptyBlock stm- - --- | Get the value of a variable. -val :: Var t -> Exp t -val = JValueOf +++-- | Get the value of a variable.+val :: Var t -> Exp t+val = JValueOf++-------------------------------------------------------------------+-- Pretty print JavaScript+-------------------------------------------------------------------++-- Pretty printing a block of JavaScript code using line breaks+-- and indentation. +renderBlock :: Block r -> String+renderBlock = render . ppBlock++-- Number of spaces for indent+indent :: Int+indent = 2++ppBlock :: Block r -> Doc+ppBlock block = case block of+ EmptyBlock -> empty+ Sequence b stm -> ppBlock b $+$ ppStmt stm <> semi++ppVar :: Var a -> Doc+ppVar = text . show++ppExp :: Exp a -> Doc+ppExp exp = case exp of+ JInt n -> int n + JFloat f -> float f+ JBool b -> if b then + text "true" + else + text "false"+ JString s -> quotes $ text s+ JRec e1 e2 -> text "{fst:" <> ppExp e1 <> comma <>+ text "snd:" <> ppExp e2 <> text "}"++ JFst e -> ppExp exp <> text ".fst"+ JSnd e -> ppExp e <> text ".snd"+ JConst c -> text c+ JAssign v e -> ppVar v <+> equals <+> ppExp e+ JAssignWith v op e -> ppVar v <+> text (show op) <+> ppExp e+ JNeg e -> text "-" <> parens (ppExp e)+ JNot e -> text "!" <> parens (ppExp e)+ JBinOp e1 op e2 -> ppExp e1 <> text (show op) <> ppExp e2 + JIncrement pp e -> if (pp == Pre) then + text "++" <> ppVar e + else + ppVar e <> text "++"+ JDecrement pp e -> if (pp == Pre) then + text "--" <> ppVar e + else + ppVar e <> text "--"+ JIfOp e1 e2 e3 -> ppExp e1 <+> char '?' <+> ppExp e2 <> + char ':' <+> ppExp e3+ JCall f a -> ppExp f <> text (showsArgs a "")+ JNew c a -> text "new" <+> text (show c) <> + text (showsArgs a "")+ JDeref o e -> text (show o) <> char '.' <> text e+ JFunction n fp b -> text "function" <+> + ppMaybe n <>+ (text $ showsFParams fp "") <>+ braces (ppBlock b)+ JThis -> text "this"+ JBlock b -> ppBlock b+ JNull -> text "null"+ JIsImpl ob c -> text (shows ob "") <> char '.' <> + text (showsFeature c "")+ JValueOf v -> ppVar v+ JCastObject e -> ppExp e+ JShow e -> ppExp e++ppStmt :: Stmt a -> Doc +ppStmt stm = case stm of+ VarDecl s -> text "var" <+> text s+ VarAssign s e -> text s <+> text "=" <+> ppExp e+ VarDeclAssign s e -> text "var" <+> text s <+> text "=" <+> ppExp e + ExpStmt e -> ppExp e+ While e b -> text "while" <> + parens (ppExp e) <+> lbrace $+$ + (nest indent $ ppBlock b) $+$ + rbrace+ DoWhile b e -> text "do" <+> lbrace $+$ + (nest indent (ppBlock b)) $+$ + rbrace <+> text "while" <+> parens (ppExp e)+ For e1 e2 e3 b -> text "for" <> + parens (ppStmt e1 <> semi <+> ppExp e2 <> semi <+> ppExp e3) <+> + lbrace $+$ + (nest indent (ppBlock b)) $+$+ rbrace+ Break -> text "break"+ Continue -> text "continue"+ Return e -> text "return" <+> ppExp e+ If e1 b1 b2 -> text "if" <+> parens (ppExp e1) <+> + lbrace $+$ (nest indent (ppBlock b1)) $+$ + rbrace $+$ + ppElses b2++ppElses :: Elses a -> Doc+ppElses elses = case elses of+ Elseif e b els -> text "else" <+> lbrace $+$ + (nest indent $ ppBlock b) $+$ rbrace <> ppElses els+ Else b -> text "else" <+> lbrace $+$ + (nest indent $ ppBlock b) $+$ rbrace + NoElse -> empty+ +ppMaybe (Just s) = text $ show s+ppMaybe Nothing = empty