CoreErlang (empty) → 0.0.1
raw patch · 9 files changed
+1256/−0 lines, 9 filesdep +basedep +parsecdep +prettysetup-changed
Dependencies added: base, parsec, pretty
Files
- AUTHORS +2/−0
- CoreErlang.cabal +33/−0
- LICENSE +38/−0
- Language/CoreErlang/Parser.hs +387/−0
- Language/CoreErlang/Pretty.hs +421/−0
- Language/CoreErlang/Syntax.hs +155/−0
- Setup.hs +6/−0
- hcar/hcar.sty +183/−0
- hcar/template.tex +31/−0
+ AUTHORS view
@@ -0,0 +1,2 @@+David Castro Pérez <dcastrop@udc.es>+Henrique Ferreiro García <hferreiro@udc.es>
+ CoreErlang.cabal view
@@ -0,0 +1,33 @@+name: CoreErlang+version: 0.0.1+copyright: 2008, David Castro Pérez, Henrique Ferreiro García+license: BSD3+license-file: LICENSE+author: David Castro Pérez <dcastrop@udc.es>+ Henrique Ferreiro García <hferreiro@udc.es>+maintainer: Henrique Ferreiro García <hferreiro@udc.es>+ David Castro Pérez <dcastrop@udc.es>+homepage: .+stability: Experimental+category: Language+synopsis: Manipulating Core Erlang source code+description:+ Facilities for manipulating Core Erlang source code:+ an abstract syntax, parser and pretty-printer.+build-type: Simple+cabal-version: >= 1.2++extra-source-files:+ AUTHORS LICENSE++flag split-base++library+ exposed-modules:+ Language.CoreErlang.Parser,+ Language.CoreErlang.Pretty,+ Language.CoreErlang.Syntax+ if flag(split-base)+ build-depends: base >= 3, parsec == 2.1.0.0, pretty+ else+ build-depends: base < 3, parsec == 2.1.0.0
+ LICENSE view
@@ -0,0 +1,38 @@+Copyright (c) 2008, David Castro Pérez <dcastrop@udc.es>+ Henrique Ferreiro García <hferreiro@udc.es>++This library is derived from code from the GHC project (libraries/haskell-src)+which is largely (c) The University of Glasgow, and distributable under+a BSD-style license. The full text of the license is reproduced below:++The Glasgow Haskell Compiler License++Copyright 2004, The University Court of the University of Glasgow. +All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++- Redistributions of source code must retain the above copyright notice,+this list of conditions and the following disclaimer.+ +- Redistributions in binary form must reproduce the above copyright notice,+this list of conditions and the following disclaimer in the documentation+and/or other materials provided with the distribution.+ +- Neither name of the University nor the names of its contributors may be+used to endorse or promote products derived from this software without+specific prior written permission. ++THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF+GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND+FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH+DAMAGE.
+ Language/CoreErlang/Parser.hs view
@@ -0,0 +1,387 @@+-----------------------------------------------------------------------------+-- |+-- Module : Language.CoreErlang.Parser+-- Copyright : (c) Henrique Ferreiro García 2008+-- (c) David Castro Pérez 2008+-- License : BSD-style (see the file LICENSE)+--+-- Maintainer : Henrique Ferreiro García <hferreiro@udc.es>+-- David Castro Pérez <dcastrop@udc.es>+-- Stability : experimental+-- Portability : portable+--+-- CoreErlang parser.+-- <http://www.it.uu.se/research/group/hipe/cerl/>++-----------------------------------------------------------------------------++module Language.CoreErlang.Parser+ ( parseModule+ , ParseError+ ) where++import Language.CoreErlang.Syntax++import Control.Monad ( liftM )+import Data.Char ( isControl, chr )+import Numeric ( readOct )++import Text.ParserCombinators.Parsec+import Text.ParserCombinators.Parsec.Expr+import qualified Text.ParserCombinators.Parsec.Token as Token+import Text.ParserCombinators.Parsec.Token+ ( makeTokenParser, TokenParser )+import Text.ParserCombinators.Parsec.Language++-- Lexical definitions++uppercase :: Parser Char+uppercase = upper++lowercase :: Parser Char+lowercase = lower++inputchar :: Parser Char+inputchar = noneOf "\n\r"++control :: Parser Char+control = satisfy isControl++namechar :: Parser Char+namechar = uppercase <|> lowercase <|> digit <|> oneOf "@_"++escape :: Parser Char+escape = do char '\\'+ s <- octal <|> ctrl <|> escapechar+ return s++octal :: Parser Char+octal = do chars <- tryOctal+ let [(o, _)] = readOct chars+ return (chr o)++tryOctal :: Parser [Char]+tryOctal = choice [ try (count 3 octaldigit),+ try (count 2 octaldigit),+ try (count 1 octaldigit) ]++octaldigit :: Parser Char+octaldigit = oneOf "01234567"++ctrl :: Parser Char+ctrl = char '^' >> ctrlchar++ctrlchar :: Parser Char+ctrlchar = satisfy (`elem` ['\x0040'..'\x005f'])++escapechar = oneOf "bdefnrstv\"\'\\"++-- Terminals++integer :: Parser Integer+integer = do i <- positive <|> negative <|> decimal+ whiteSpace -- TODO: buff+ return $ i++positive :: Parser Integer+positive = do char '+'+ p <- decimal+ return p++negative :: Parser Integer+negative = do char '-'+ n <- decimal+ return $ negate n++-- float :: Parser Double+-- float = sign?digit+.digit+((E|e)sign?digit+)?++atom :: Parser Atom+atom = do char '\''+-- ((inputchar except control and \ and ')|escape)*+-- inputchar = noneOf "\n\r"+ a <- many (noneOf "\n\r\\\'")+ char '\''+ whiteSpace -- TODO: buff+ return $ Atom a++echar :: Parser Literal+-- char = $((inputchar except control and space and \)|escape)+echar = do char '$'+ c <- noneOf "\n\r\\ "+ whiteSpace -- TODO: buff+ return $ LChar c++estring :: Parser Literal+-- string = "((inputchar except control and \\ and \"")|escape)*"+estring = do char '"'+ s <- many $ noneOf "\n\r\\\""+ char '"'+ return $ LString s++variable :: Parser Var+-- variable = (uppercase | (_ namechar)) namechar*+variable = identifier++-- Non-terminals++emodule :: Parser (Ann Module)+emodule = annotated amodule++amodule :: Parser Module+amodule = do reserved "module"+ name <- atom+ funs <- exports+ attrs <- attributes+ fundefs <- many fundef+ reserved "end"+ return $ Module name funs attrs fundefs++exports :: Parser [Function]+exports = brackets $ commaSep function++attributes :: Parser [(Atom,Const)]+attributes = do reserved "attributes"+ brackets (commaSep $ do a <- atom+ symbol "="+ c <- constant+ return (a,c))++constant :: Parser Const+constant = liftM CLit (try literal) <|>+ liftM CTuple (tuple constant) <|>+ liftM CList (elist constant)++fundef :: Parser FunDef+fundef = do name <- annotated function+ symbol "="+ body <- annotated lambda+ return $ FunDef name body++function :: Parser Function+function = do a <- atom+ char '/'+ i <- decimal+ whiteSpace -- TODO: buff+ return $ Function (a,i)++literal :: Parser Literal+literal = liftM LInt integer <|> liftM LFloat float <|>+ liftM LAtom atom <|> nil <|> echar <|> estring++nil :: Parser Literal+nil = brackets (return LNil)++expression :: Parser Exps+expression = try (liftM Exps (annotated $ angles $ commaSep (annotated sexpression))) <|>+ liftM Exp (annotated sexpression)++sexpression :: Parser Exp+sexpression = app <|> ecatch <|> ecase <|> elet <|>+ liftM Fun (try function) {- because of atom -} <|>+ lambda <|> letrec <|> liftM Binary (ebinary expression) <|>+ liftM List (try $ elist expression) {- because of nil -} <|>+ liftM Lit literal <|> modcall <|> op <|> receive <|>+ eseq <|> etry <|> liftM Tuple (tuple expression) <|>+ liftM Var variable++app :: Parser Exp+app = do reserved "apply"+ e1 <- expression+ eN <- parens $ commaSep expression+ return $ App e1 eN++ecatch :: Parser Exp+ecatch = do reserved "catch"+ e <- expression+ return $ Catch e++ebinary :: Parser a -> Parser [BitString a]+ebinary p = do symbol "#"+ bs <- braces (commaSep (bitstring p))+ symbol "#"+ return bs++bitstring :: Parser a -> Parser (BitString a)+bitstring p = do symbol "#"+ e0 <- angles p+ es <- parens (commaSep expression)+ return $ BitString e0 es++ecase :: Parser Exp+ecase = do reserved "case"+ exp <- expression+ reserved "of"+ alts <- many1 (annotated clause)+ reserved "end"+ return $ Case exp alts++clause :: Parser Alt+clause = do pat <- patterns+ g <- guard+ symbol "->"+ exp <- expression+ return $ Alt pat g exp++patterns :: Parser Pats+patterns = liftM Pat pattern <|>+ liftM Pats (angles $ commaSep pattern)++pattern :: Parser Pat+pattern = liftM PAlias (try alias) {- because of variable -} <|> liftM PVar variable <|>+ liftM PLit (try literal) {- because of nil -} <|> liftM PTuple (tuple pattern) <|>+ liftM PList (elist pattern) <|> liftM PBinary (ebinary pattern)++alias :: Parser Alias+alias = do v <- variable+ symbol "="+ p <- pattern+ return $ Alias v p++guard :: Parser Guard+guard = do reserved "when"+ e <- expression+ return $ Guard e++elet :: Parser Exp+elet = do reserved "let"+ vars <- variables+ symbol "="+ e1 <- expression+ symbol "in"+ e2 <- expression+ return $ Let (vars,e1) e2++variables :: Parser [Var]+variables = do { v <- variable; return [v]} <|> (angles $ commaSep variable)++lambda :: Parser Exp+lambda = do reserved "fun"+ vars <- parens $ commaSep variable+ symbol "->"+ expr <- expression+ return $ Lambda vars expr++letrec :: Parser Exp+letrec = do reserved "letrec"+ defs <- many fundef+ reserved "in"+ e <- expression+ return $ LetRec defs e++elist :: Parser a -> Parser (List a)+elist a = brackets $ list a++list :: Parser a -> Parser (List a)+list elem = do elems <- commaSep1 elem+ option (L elems) (do symbol "|"+ t <- elem+ return $ LL elems t)++modcall :: Parser Exp+modcall = do reserved "call"+ e1 <- expression+ symbol ":"+ e2 <- expression+ eN <- parens $ commaSep expression+ return $ ModCall (e1, e2) eN++op :: Parser Exp+op = do reserved "primop"+ a <- atom+ e <- parens $ commaSep expression+ return $ Op a e++receive :: Parser Exp+receive = do reserved "receive"+ alts <- many $ annotated clause+ to <- timeout+ return $ Rec alts to++timeout :: Parser TimeOut+timeout = do reserved "after"+ e1 <- expression+ symbol "->"+ e2 <- expression+ return $ TimeOut e1 e2++eseq :: Parser Exp+eseq = do reserved "do"+ e1 <- expression+ e2 <- expression+ return $ Seq e1 e2++etry :: Parser Exp+etry = do reserved "try"+ e1 <- expression+ reserved "of"+ v1 <- variables+ symbol "->"+ e2 <- expression+ reserved "catch"+ v2 <- variables+ symbol "->"+ e3 <- expression+ return $ Try e1 (v1,e1) (v2,e2)++tuple :: Parser a -> Parser [a]+tuple elem = braces $ commaSep elem++annotation :: Parser [Const]+annotation = do symbol "-|"+ cs <- brackets $ many constant+ return $ cs++annotated :: Parser a -> Parser (Ann a)+annotated p = parens (do e <- p+ cs <- annotation+ return $ Ann e cs)+ <|>+ do e <- p+ return $ Constr e++lexer :: TokenParser ()+lexer = makeTokenParser+ (emptyDef {+ -- commentStart = "",+ -- commentEnd = "",+ commentLine = "%",+ -- nestedComments = True,+ identStart = upper <|> char '_',+ identLetter = namechar+ -- opStart,+ -- opLetter,+ -- reservedNames,+ -- reservedOpNames,+ -- caseSensitive = True,+ })++angles = Token.angles lexer+braces = Token.braces lexer+brackets = Token.brackets lexer+commaSep = Token.commaSep lexer+commaSep1 = Token.commaSep1 lexer+decimal = Token.decimal lexer+float = Token.float lexer+identifier = Token.identifier lexer+natural = Token.natural lexer+parens = Token.parens lexer+reserved = Token.reserved lexer+reservedOp = Token.reservedOp lexer+symbol = Token.symbol lexer+whiteSpace = Token.whiteSpace lexer++runLex :: Show a => Parser a -> String -> IO ()+runLex p file = do input <- readFile file+ parseTest (do whiteSpace+ x <- p+ eof+ return x) input+ return ()++-- | Parse of a string, which should contain a complete CoreErlang module+parseModule :: String -> Either ParseError (Ann Module)+parseModule input = parse (do whiteSpace+ x <- emodule+ eof+ return x) "" input
+ Language/CoreErlang/Pretty.hs view
@@ -0,0 +1,421 @@+-----------------------------------------------------------------------------+-- |+-- Module : Language.CoreErlang.Pretty+-- Copyright : (c) Henrique Ferreiro García 2008+-- (c) David Castro Pérez 2008+-- License : BSD-style (see the file LICENSE)+--+-- Maintainer : Henrique Ferreiro García+-- David Castro Pérez+-- Stability : experimental+-- Portability : portable+--+-- Pretty printer for CoreErlang.+--+-----------------------------------------------------------------------------++module Language.CoreErlang.Pretty (+ -- * Pretty printing+ Pretty,+ prettyPrintStyleMode, prettyPrintWithMode, prettyPrint,+ -- * Pretty-printing styles (from -- "Text.PrettyPrint.HughesPJ")+ P.Style(..), P.style, P.Mode(..),+ -- * CoreErlang formatting modes+ PPMode(..), Indent, PPLayout(..), defaultMode) where++import Language.CoreErlang.Syntax++import qualified Text.PrettyPrint as P++infixl 5 $$$++-------------------------------------------------------------------------------++-- | Varieties of layout we can use.+data PPLayout = PPDefault -- ^ classical layout+ | PPNoLayout -- ^ everything on a single line+ deriving Eq++type Indent = Int++-- | Pretty-printing parameters.+data PPMode = PPMode {+ altIndent :: Indent, -- ^ indentation of the alternatives+ -- in a @case@ expression+ caseIndent :: Indent, -- ^ indentation of the declarations+ -- in a @case@ expression+ fundefIndent :: Indent, -- ^ indentation of the declarations+ -- in a function definition+ lambdaIndent :: Indent, -- ^ indentation of the declarations+ -- in a @lambda@ expression+ letIndent :: Indent, -- ^ indentation of the declarations+ -- in a @let@ expression+ letrecIndent :: Indent, -- ^ indentation of the declarations+ -- in a @letrec@ expression+ onsideIndent :: Indent, -- ^ indentation added for continuation+ -- lines that would otherwise be offside+ layout :: PPLayout -- ^ Pretty-printing style to use+ }++-- | The default mode: pretty-print using sensible defaults.+defaultMode :: PPMode+defaultMode = PPMode {+ altIndent = 4,+ caseIndent = 4,+ fundefIndent = 4,+ lambdaIndent = 4,+ letIndent = 4,+ letrecIndent = 4,+ onsideIndent = 4,+ layout = PPDefault+ }++-- | Pretty printing monad+newtype DocM s a = DocM (s -> a)++instance Functor (DocM s) where+ fmap f xs = do x <- xs; return (f x)++instance Monad (DocM s) where+ (>>=) = thenDocM+ (>>) = then_DocM+ return = retDocM++{-# INLINE thenDocM #-}+{-# INLINE then_DocM #-}+{-# INLINE retDocM #-}+{-# INLINE unDocM #-}+{-# INLINE getPPEnv #-}++thenDocM :: DocM s a -> (a -> DocM s b) -> DocM s b+thenDocM m k = DocM $ (\s -> case unDocM m $ s of a -> unDocM (k a) $ s)++then_DocM :: DocM s a -> DocM s b -> DocM s b+then_DocM m k = DocM $ (\s -> case unDocM m $ s of _ -> unDocM k $ s)++retDocM :: a -> DocM s a+retDocM a = DocM (\_s -> a)++unDocM :: DocM s a -> (s -> a)+unDocM (DocM f) = f++-- all this extra stuff, just for this one function.+getPPEnv :: DocM s s+getPPEnv = DocM id++-- | The document type produced by these pretty printers uses a 'PPMode'+-- environment.+type Doc = DocM PPMode P.Doc++-- | Things that can be pretty-printed, including all the syntactic objects+-- in "Language.CoreErlang.Syntax".+class Pretty a where+ -- | Pretty-print something in isolation.+ pretty :: a -> Doc+ -- | Pretty-print something in a precedence context.+ prettyPrec :: Int -> a -> Doc+ pretty = prettyPrec 0+ prettyPrec _ = pretty++-- The pretty printing combinators++empty :: Doc+empty = return P.empty++nest :: Int -> Doc -> Doc+nest i m = m >>= return . P.nest i++-- Literals+text, ptext :: String -> Doc+text = return . P.text+ptext = return . P.text++char :: Char -> Doc+char = return . P.char++int :: Int -> Doc+int = return . P.int++integer :: Integer -> Doc+integer = return . P.integer++float :: Float -> Doc+float = return . P.float++double :: Double -> Doc+double = return . P.double++-- Simple Combining Forms+parens, brackets, braces, quotes, doubleQuotes :: Doc -> Doc+parens d = d >>= return . P.parens+brackets d = d >>= return . P.brackets+braces d = d >>= return . P.braces+quotes d = d >>= return . P.quotes+doubleQuotes d = d >>= return . P.doubleQuotes++parensIf :: Bool -> Doc -> Doc+parensIf True = parens+parensIf False = id++-- Constants+semi, comma, colon, space, equals :: Doc+semi = return P.semi+comma = return P.comma+colon = return P.colon+space = return P.space+equals = return P.equals++lparen, rparen, lbrack, rbrack, lbrace, rbrace :: Doc+lparen = return P.lparen+rparen = return P.rparen+lbrack = return P.lbrack+rbrack = return P.rbrack+lbrace = return P.lbrace+rbrace = return P.rbrace++-- Combinators++(<>),(<+>),($$),($+$) :: Doc -> Doc -> Doc+aM <> bM = do { a <- aM; b <- bM; return $ a P.<> b}+aM <+> bM = do { a <- aM; b <- bM; return $ a P.<+> b}+aM $$ bM = do { a <- aM; b <- bM; return $ a P.$$ b}+aM $+$ bM = do { a <- aM; b <- bM; return $ a P.$+$ b}++hcat, hsep, vcat, sep, cat, fsep, fcat :: [Doc] -> Doc+hcat dl = sequence dl >>= return . P.hcat+hsep dl = sequence dl >>= return . P.hsep+vcat dl = sequence dl >>= return . P.vcat+sep dl = sequence dl >>= return . P.sep+cat dl = sequence dl >>= return . P.cat+fsep dl = sequence dl >>= return . P.fsep+fcat dl = sequence dl >>= return . P.fcat++-- Some More++hang :: Doc -> Int -> Doc -> Doc+hang dM i rM = do { d <- dM; r <- rM; return $ P.hang d i r }++-- Yuk, had to cut-n-paste this one from Pretty.hs+punctuate :: Doc -> [Doc] -> [Doc]+punctuate _ [] = []+punctuate p (d1:ds) = go d1 ds+ where+ go d [] = [d]+ go d (e:es) = (d <> p) : go e es++-- | render the document with a given style and mode.+renderStyleMode :: P.Style -> PPMode -> Doc -> String+renderStyleMode ppStyle ppMode d = P.renderStyle ppStyle . unDocM d $ ppMode++-- | render the document with a given mode.+renderWithMode :: PPMode -> Doc -> String+renderWithMode = renderStyleMode P.style++-- | render the document with defaultMode+render :: Doc -> String+render = renderWithMode defaultMode++-- | pretty-print with a given style and mode.+prettyPrintStyleMode :: Pretty a => P.Style -> PPMode -> a -> String+prettyPrintStyleMode ppStyle ppMode = renderStyleMode ppStyle ppMode . pretty++-- | pretty-print with the default style and a given mode.+prettyPrintWithMode :: Pretty a => PPMode -> a -> String+prettyPrintWithMode = prettyPrintStyleMode P.style++-- | pretty-print with the default style and 'defaultMode'.+prettyPrint :: Pretty a => a -> String+prettyPrint = prettyPrintWithMode defaultMode++fullRenderWithMode :: PPMode -> P.Mode -> Int -> Float ->+ (P.TextDetails -> a -> a) -> a -> Doc -> a+fullRenderWithMode ppMode m i f fn e mD =+ P.fullRender m i f fn e $ (unDocM mD) ppMode++fullRender :: P.Mode -> Int -> Float -> (P.TextDetails -> a -> a)+ -> a -> Doc -> a+fullRender = fullRenderWithMode defaultMode++------------------------- Pretty-Print a Module --------------------+instance Pretty Module where+ pretty (Module m exports attrs fundefs) = + topLevel (ppModuleHeader m exports attrs)+ (map pretty fundefs)++-------------------------- Module Header ------------------------------+ppModuleHeader :: Atom -> [Function] -> [(Atom,Const)] -> Doc+ppModuleHeader m exports attrs = myFsep [+ text "module" <+> pretty m <+> (bracketList $ map pretty exports),+ text "attributes" <+> bracketList (map ppAssign attrs)]++instance Pretty Function where+ pretty (Function (name,arity)) =+ pretty name <> char '/' <> integer arity++instance Pretty Const where+ pretty (CLit l) = pretty l+ pretty (CTuple l) = ppTuple l + pretty (CList l) = pretty l++------------------------- Declarations ------------------------------+instance Pretty FunDef where+ pretty (FunDef function exp) = (pretty function <+> char '=') $$$+ ppBody fundefIndent [pretty exp]++------------------------- Expressions -------------------------+instance Pretty Literal where+ pretty (LChar c) = char c+ pretty (LString s) = text (show s)+ pretty (LInt i) = integer i+ pretty (LFloat f) = double f+ pretty (LAtom a) = pretty a+ pretty LNil = bracketList [empty]++instance Pretty Atom where+ pretty (Atom a) = char '\'' <> text a <> char '\''++instance Pretty Exps where+ pretty (Exp e) = pretty e+ pretty (Exps (Constr e)) = angleList (map pretty e)+ pretty (Exps (Ann e cs)) = parens (angleList (map pretty e)+ $$$ ppAnn cs)++instance Pretty Exp where+ pretty (Var v) = text v+ pretty (Lit l) = pretty l+ pretty (Fun f) = pretty f+ pretty (App e exps) = text "apply" <+>+ pretty e <> parenList (map pretty exps)+ pretty (ModCall (e1,e2) exps) = sep [text "call" <+>+ pretty e1 <> char ':' <> pretty e2,+ parenList (map pretty exps)]+ pretty (Lambda vars e) = sep [text "fun" <> parenList (map text vars) <+> text "->",+ ppBody lambdaIndent [pretty e]]+ pretty (Seq e1 e2) = sep [text "do", pretty e1, pretty e2]+ pretty (Let (vars,e1) e2) = text "let" <+>+ angleList (map text vars) <+>+ char '=' <+> pretty e1+ $$$ text "in" <+> pretty e2+ pretty (LetRec fundefs e) = sep [text "letrec" <+>+ ppBody letrecIndent (map pretty fundefs),+ text "in", pretty e]+ pretty (Case e alts) = sep [text "case", pretty e, text "of"]+ $$$ ppBody caseIndent (map pretty alts)+ $$$ text "end"+ pretty (Tuple exps) = braceList $ map pretty exps+ pretty (List l) = pretty l+ pretty (Op a exps) = text "primop" <+> pretty a <> parenList (map pretty exps)+ pretty (Binary bs) = char '#' <> braceList (map pretty bs) <> char '#'+ pretty (Try e (vars1,exps1) (vars2,exps2)) = text "try"+ $$$ ppBody caseIndent [pretty e]+ $$$ text "of" <+> angleList (map text vars1) <+> text "->"+ $$$ ppBody altIndent [pretty exps1]+ $$$ text "catch" <+> angleList (map text vars2) <+> text "->"+ $$$ ppBody altIndent [pretty exps2]+ pretty (Rec alts tout) = text "receive"+ $$$ ppBody caseIndent (map pretty alts)+ $$$ text "after"+ $$$ ppBody caseIndent [pretty tout]+ pretty (Catch e) = sep [text "catch", pretty e]++instance Pretty a => Pretty (List a) where+ pretty (L l) = bracketList $ map pretty l+ pretty (LL h t) = brackets . hcat $ punctuate comma (map pretty h) +++ [char '|' <> pretty t]+instance Pretty Alt where+ pretty (Alt pats guard exps) =+ myFsep [pretty pats, pretty guard <+> text "->"]+ $$$ ppBody altIndent [pretty exps]++instance Pretty Pats where+ pretty (Pat p) = pretty p+ pretty (Pats p) = angleList (map pretty p)++instance Pretty Pat where+ pretty (PVar v) = text v+ pretty (PLit l) = pretty l+ pretty (PTuple p) = braceList $ map pretty p+ pretty (PList l) = pretty l+ pretty (PBinary bs) = char '#' <> braceList (map pretty bs) <> char '#'+ pretty (PAlias a) = pretty a++instance Pretty Alias where+ pretty (Alias v p) = ppAssign (Var v,p) -- FIXME: hack!++instance Pretty Guard where+ pretty (Guard e) = text "when" <+> pretty e++instance Pretty TimeOut where+ pretty (TimeOut e1 e2) = pretty e1 <+> text "->"+ $$$ ppBody altIndent [pretty e2]++instance Pretty a => Pretty (BitString a) where+ pretty (BitString e es) = text "#<" <> pretty e <> char '>' <> parenList (map pretty es)++----------------------- Annotations ------------------------+instance Pretty a => Pretty (Ann a) where+ pretty (Constr a) = pretty a+ pretty (Ann a cs) = parens (pretty a $$$ ppAnn cs)+++------------------------- pp utils -------------------------+angles :: Doc -> Doc+angles p = char '<' <> p <> char '>'++angleList :: [Doc] -> Doc+angleList = angles . myFsepSimple . punctuate comma++braceList :: [Doc] -> Doc+braceList = braces . myFsepSimple . punctuate comma++bracketList :: [Doc] -> Doc+bracketList = brackets . myFsepSimple . punctuate comma++parenList :: [Doc] -> Doc+parenList = parens . myFsepSimple . punctuate comma++-- | Monadic PP Combinators -- these examine the env+topLevel :: Doc -> [Doc] -> Doc+topLevel header dl = do e <- fmap layout getPPEnv+ let s = case e of+ PPDefault -> header $$ vcat dl+ PPNoLayout -> header <+> hsep dl+ s $$$ text "end"++ppAssign :: (Pretty a,Pretty b) => (a,b) -> Doc+ppAssign (a,b) = pretty a <+> char '=' <+> pretty b++ppTuple :: Pretty a => [a] -> Doc+ppTuple t = braceList (map pretty t)++ppBody :: (PPMode -> Int) -> [Doc] -> Doc+ppBody f dl = do e <- fmap layout getPPEnv+ i <- fmap f getPPEnv+ case e of+ PPDefault -> nest i . vcat $ dl+ _ -> hsep dl++($$$) :: Doc -> Doc -> Doc+a $$$ b = layoutChoice (a $$) (a <+>) b++myFsepSimple :: [Doc] -> Doc+myFsepSimple = layoutChoice fsep hsep++-- same, except that continuation lines are indented,+-- which is necessary to avoid triggering the offside rule.+myFsep :: [Doc] -> Doc+myFsep = layoutChoice fsep' hsep+ where fsep' [] = empty+ fsep' (d:ds) = do+ e <- getPPEnv+ let n = onsideIndent e+ nest n (fsep (nest (-n) d:ds))++layoutChoice :: (a -> Doc) -> (a -> Doc) -> a -> Doc+layoutChoice a b dl = do e <- getPPEnv+ if layout e == PPDefault+ then a dl+ else b dl++ppAnn :: (Pretty a) => [a] -> Doc+ppAnn cs = text "-|" <+> bracketList (map pretty cs)
+ Language/CoreErlang/Syntax.hs view
@@ -0,0 +1,155 @@+-----------------------------------------------------------------------------+-- |+-- Module : Language.CoreErlang.Syntax+-- Copyright : (c) Henrique Ferreiro García 2008+-- (c) David Castro Pérez 2008+-- License : BSD-style (see the file LICENSE)+--+-- Maintainer : Henrique Ferreiro García <hferreiro@udc.es>+-- David Castro Pérez <dcastrop@udc.es>+-- Stability : experimental+-- Portability : portable+--+-- A suite of datatypes describing the abstract syntax of CoreErlang 1.0.3.+-- <http://www.it.uu.se/research/group/hipe/cerl/>++-----------------------------------------------------------------------------++module Language.CoreErlang.Syntax (+ -- * Modules+ Module(..),+ -- * Declarations+ FunDef(..),+ -- * Expressions+ Exp(..), Exps(..), Alt(..), Guard(..),+ List(..), TimeOut(..), BitString(..), Function(..),+ -- * Patterns+ Pats(..), Pat(..), Alias(..),+ -- * Literals+ Literal(..), Const(..), Atom(..),+ -- * Variables+ Var,+ -- * Annotations+ Ann(..),+ ) where++-- | This type is used to represent variables+type Var = String++-- | This type is used to represent atoms+data Atom = Atom String+ deriving (Eq,Ord,Show)++-- | This type is used to represent function names+data Function = Function (Atom,Integer)+ deriving (Eq,Ord,Show)++-- | A CoreErlang source module.+data Module+ = Module Atom [Function] [(Atom,Const)] [FunDef]+ deriving (Eq,Ord,Show)++-- | This type is used to represent constants+data Const+ = CLit Literal+ | CTuple [Const]+ | CList (List Const)+ deriving (Eq,Ord,Show)++-- | This type is used to represent lambdas+data FunDef+ = FunDef (Ann Function) (Ann Exp)+ deriving (Eq,Ord,Show)++-- | /literal/.+-- Values of this type hold the abstract value of the literal, not the+-- precise string representation used. For example, @10@, @0o12@ and @0xa@+-- have the same representation.+data Literal+ = LChar Char -- ^ character literal+ | LString String -- ^ string literal+ | LInt Integer -- ^ integer literal+ | LFloat Double -- ^ floating point literal+ | LAtom Atom -- ^ atom literal+ | LNil -- ^ empty list+ deriving (Eq,Ord,Show)++-- | CoreErlang expressions.+data Exps+ = Exp (Ann Exp) -- ^ single expression+ | Exps (Ann [Ann Exp]) -- ^ list of expressions+ deriving (Eq,Ord,Show)++-- | CoreErlang expression.+data Exp+ = Var Var -- ^ variable+ | Lit Literal -- ^ literal constant+ | Fun Function -- ^ function name+ | App Exps [Exps] -- ^ application+ | ModCall (Exps,Exps) [Exps] -- ^ module call+ | Lambda [Var] Exps -- ^ lambda expression+ | Seq Exps Exps -- ^ sequencing+ | Let ([Var],Exps) Exps -- ^ local declaration+ | LetRec [FunDef] Exps -- ^ letrec expression+ | Case Exps [Ann Alt] -- ^ @case@ /exp/ @of@ /alts/ end+ | Tuple [Exps] -- ^ tuple expression+ | List (List Exps) -- ^ list expression+ | Binary [BitString Exps] -- ^ binary expression+ | Op Atom [Exps] -- ^ operator application+ | Try Exps ([Var],Exps) ([Var],Exps) -- ^ try expression+ | Rec [Ann Alt] TimeOut -- ^ receive expression+ | Catch Exps -- ^ catch expression+ deriving (Eq,Ord,Show)++-- | A bitstring.+data BitString a+ = BitString a [Exps]+ deriving (Eq,Ord,Show)++-- | A list of expressions+data List a+ = L [a]+ | LL [a] a+ deriving (Eq,Ord,Show)++-- | An /alt/ in a @case@ expression+data Alt+ = Alt Pats Guard Exps+ deriving (Eq,Ord,Show)++data Pats+ = Pat Pat -- ^ single pattern+ | Pats [Pat] -- ^ list of patterns+ deriving (Eq,Ord,Show)++-- | A pattern, to be matched against a value.+data Pat+ = PVar Var -- ^ variable+ | PLit Literal -- ^ literal constant+ | PTuple [Pat] -- ^ tuple pattern+ | PList (List Pat) -- ^ list pattern+ | PBinary [BitString Pat] -- ^ list of bitstring patterns+ | PAlias Alias -- ^ alias pattern+ deriving (Eq,Ord,Show)++-- | An alias, used in patterns+data Alias+ = Alias Var Pat+ deriving (Eq,Ord,Show)++-- | A guarded alternative @when@ /exp/ @->@ /exp/.+-- The first expression will be Boolean-valued.+data Guard+ = Guard Exps+ deriving (Eq,Ord,Show)++-- | The timeout of a receive expression+data TimeOut+ = TimeOut Exps Exps+ deriving (Eq,Ord,Show)++-- | An annotation for modules, variables, ...+data Ann a+ = Constr a -- ^ core erlang construct+ | Ann a [Const] -- ^ core erlang annotated construct+ deriving (Eq,Ord,Show)
+ Setup.hs view
@@ -0,0 +1,6 @@+module Main (main) where++import Distribution.Simple++main :: IO ()+main = defaultMain
+ hcar/hcar.sty view
@@ -0,0 +1,183 @@+\ProvidesPackage{hcar}++\newif\ifhcarfinal+\hcarfinalfalse+\DeclareOption{final}{\hcarfinaltrue}+\ProcessOptions++\RequirePackage{keyval}+\RequirePackage{color}+\RequirePackage{array}++\ifhcarfinal+ \RequirePackage[T1]{fontenc}+ \RequirePackage{lmodern}+ \RequirePackage{tabularx}+ \RequirePackage{booktabs}+ \RequirePackage{framed}+ \RequirePackage[obeyspaces,T1]{url}+ \RequirePackage+ [bookmarks=true,colorlinks=true,+ urlcolor=urlcolor,+ linkcolor=linkcolor,+ breaklinks=true,+ pdftitle={Haskell Communities and Activities Report}]%+ {hyperref}+\else+ \RequirePackage[obeyspaces]{url}+\fi+\urlstyle{sf}++\definecolor{urlcolor}{rgb}{0.1,0.3,0}+\definecolor{linkcolor}{rgb}{0.3,0,0}+\definecolor{shadecolor}{rgb}{0.9,0.95,1}%{0.98,1.0,0.95}+\definecolor{framecolor}{gray}{0.9}+\definecolor{oldgray}{gray}{0.7}++\newcommand{\Contact}{\subsubsection*{Contact}}+\newcommand{\FurtherReading}{\subsubsection*{Further reading}}+\newcommand{\FuturePlans}{\subsubsection*{Future plans}}+\newcommand{\Separate}{\smallskip\noindent}+\newcommand{\FinalNote}{\smallskip\noindent}++\newcommand{\urlpart}{\begingroup\urlstyle{sf}\Url}+\newcommand{\email}[1]{\href{mailto:\EMailRepl{#1}{ at }}{$\langle$\urlpart{#1}$\rangle$}}+\newcommand{\cref}[1]{($\rightarrow\,$\ref{#1})}++\ifhcarfinal+ \let\hcarshaded=\shaded+ \let\endhcarshaded=\endshaded+\else+ \newsavebox{\shadedbox}+ \newlength{\shadedboxwidth}+ \def\hcarshaded+ {\begingroup+ \setlength{\shadedboxwidth}{\linewidth}%+ \addtolength{\shadedboxwidth}{-2\fboxsep}%+ \begin{lrbox}{\shadedbox}%+ \begin{minipage}{\shadedboxwidth}\ignorespaces}+ \def\endhcarshaded+ {\end{minipage}%+ \end{lrbox}%+ \noindent+ \colorbox{shadecolor}{\usebox{\shadedbox}}%+ \endgroup}+\fi++\ifhcarfinal+ \newenvironment{hcartabularx}+ {\tabularx{\linewidth}{l>{\raggedleft}X}}+ {\endtabularx}+\else+ \newenvironment{hcartabularx}+ {\begin{tabular}{@{}m{.3\linewidth}@{}>{\raggedleft}p{.7\linewidth}@{}}}+ {\end{tabular}}+\fi++\ifhcarfinal+ \let\hcartoprule=\toprule+ \let\hcarbottomrule=\bottomrule+\else+ \let\hcartoprule=\hline+ \let\hcarbottomrule=\hline+\fi++\define@key{hcarentry}{chapter}[]{\let\level\chapter}+\define@key{hcarentry}{section}[]{\let\level\section}+\define@key{hcarentry}{subsection}[]{\let\level\subsection}+\define@key{hcarentry}{subsubsection}[]{\let\level\subsubsection}+\define@key{hcarentry}{level}{\let\level=#1}+%\define@key{hcarentry}{label}{\def\entrylabel{\label{#1}}}+\define@key{hcarentry}{new}[]%+ {\let\startnew=\hcarshaded\let\stopnew=\endhcarshaded+ \def\startupdated{\let\orig@addv\addvspace\let\addvspace\@gobble}%+ \def\stopupdated{\let\addvspace\orig@addv}}+\define@key{hcarentry}{old}[]{\def\normalcolor{\color{oldgray}}\color{oldgray}}%+\define@key{hcarentry}{updated}[]%+ {\def\startupdated+ {\leavevmode\let\orig@addv\addvspace\let\addvspace\@gobble\hcarshaded}%+ \def\stopupdated{\endhcarshaded\let\addvspace\orig@addv}}++\def\@makeheadererror{\PackageError{hcar}{hcarentry without header}{}}++\newenvironment{hcarentry}[2][]%+{\let\level\subsection+ \let\startupdated=\empty\let\stopupdated=\empty+ \let\startnew=\empty\let\stopnew=\empty+%\let\entrylabel=\empty+ \global\let\@makeheaderwarning\@makeheadererror+ \setkeys{hcarentry}{#1}%+ \startnew\startupdated+ \level{#2}%+ % test:+ \global\let\@currentlabel\@currentlabel+%\stopupdated+ \let\report@\empty+ \let\groupleaders@\empty+ \let\members@\empty+ \let\contributors@\empty+ \let\participants@\empty+ \let\developers@\empty+ \let\maintainer@\empty+ \let\status@\empty+ \let\release@\empty+ \let\portability@\empty+ \let\entry@\empty}%+{\stopnew\@makeheaderwarning}%++\renewcommand{\labelitemi}{$\circ$}+\settowidth{\leftmargini}{\labelitemi}+\addtolength{\leftmargini}{\labelsep}++\newcommand*\MakeKey[2]%+ {\expandafter\def\csname #1\endcsname##1%+ {\expandafter\def\csname #1@\endcsname{\Key@{#2}{##1}}\ignorespaces}}+\MakeKey{report}{Report by:}+\MakeKey{status}{Status:}+\MakeKey{groupleaders}{Group leaders:}+\MakeKey{members}{Members:}+\MakeKey{contributors}{Contributors:}+\MakeKey{participants}{Participants:}+\MakeKey{developers}{Developers:}+\MakeKey{maintainer}{Maintainer:}+\MakeKey{release}{Current release:}+\MakeKey{portability}{Portability:}+\MakeKey{entry}{Entry:}++\newcommand\Key@[2]{#1 & #2\tabularnewline}++\newcommand\makeheader+{\smallskip+ \begingroup+ \sffamily+ \small+ \noindent+ \let\ohrule\hrule+ \def\hrule{\color{framecolor}\ohrule}%+ \begin{hcartabularx}+ \hline+ \report@+ \groupleaders@+ \members@+ \participants@+ \developers@+ \contributors@+ \maintainer@+ \status@+ \release@+ \portability@+ \hcarbottomrule+ \end{hcartabularx}+ \endgroup+ \stopupdated+ \global\let\@makeheaderwarning\empty+ \@afterindentfalse+ \@xsect\smallskipamount}++% columns/linebreaks, interchanged+\newcommand\NCi{&\let\NX\NCii}%+\newcommand\NCii{&\let\NX\NL}%+\newcommand\NL{\\\let\NX\NCi}%+\let\NX\NCi+\newcommand\hcareditor[1]{ (ed.)&\\}+\newcommand\hcarauthor[1]{#1\NX}%
+ hcar/template.tex view
@@ -0,0 +1,31 @@+\documentclass{article}++\usepackage{hcar}++\begin{document}++\begin{hcarentry}{CoreErlang}+\report{Henrique Ferreiro Garc\'{i}a}+\participants{David Castro P\'{e}rez}+\status{Parses and pretty-prints all of Core Erlang}+\makeheader++CoreErlang is a haskell library which consists on a parser and+pretty-printer for the intermediate language used by Erlang. The parser uses+the Parsec library and the pretty-printer was modelled after the+corresponding module of the haskell-src package. It also exposes a Syntax+module which allows easy manipulation of terms.++It is able to parse and pretty print all of Core Erlang. Remaining work+includes customizing the pretty printer and refining the syntax interface.++\FurtherReading++\begin{itemize}+\item It can be downloaded from hackage at: +\item A darcs repository is available at: \url{http://code.haskell.org/CoreErlang}+\end{itemize}++\end{hcarentry}++\end{document}