Commit 7a98a8a0 authored by Michael Hanus 's avatar Michael Hanus
Browse files

Tools updated

parent 5a668b2e
......@@ -16,8 +16,12 @@ currypp/.cpm/packages/cass-analysis-0.0.4
currypp/.cpm/packages/currycheck-1.0.1
currypp/.cpm/packages/rewriting-0.0.1
currypp/.cpm/packages/verify-0.0.2
currypp/.cpm/packages/flatcurry-1.0.0
currypp/.cpm/packages/xml-0.0.1
optimize/.cpm/packages/cass-0.0.1
optimize/.cpm/packages/cass-analysis-0.0.4
optimize/.cpm/packages/flatcurry-1.0.0
optimize/.cpm/packages/xml-0.0.1
# executables
browser/BrowserGUI
......
......@@ -61,7 +61,7 @@ $(uninstall_TOOLDIRS):
# Testing the tools
# Tools with test suites:
TESTTOOLS = optimize currypp runcurry currycheck cpm
TESTTOOLS = optimize currypp runcurry cpm
# run the test suites to check the tools
.PHONY: runtest
......
......@@ -101,7 +101,7 @@ runWithArgs opts = do
Search o -> searchCmd o config repo
_ -> do globalCache <- getGlobalCache config repo
case optCommand opts of
Deps -> deps config repo globalCache
Deps -> depsCmd config repo globalCache
PkgInfo o -> infoCmd o config repo globalCache
Checkout o -> checkout o config repo globalCache
InstallApp o -> installapp o config repo globalCache
......@@ -659,8 +659,8 @@ checkExecutables = do
, "ln"
, "readlink" ]
deps :: Config -> Repository -> GlobalCache -> IO (ErrorLogger ())
deps cfg repo gc =
depsCmd :: Config -> Repository -> GlobalCache -> IO (ErrorLogger ())
depsCmd cfg repo gc =
getLocalPackageSpec "." |>= \specDir ->
resolveDependencies cfg repo gc specDir |>= \result ->
putStrLn (showResult result) >> succeedIO ()
......
......@@ -5,6 +5,7 @@
"synopsis": "Libraries with various compile-time analyses for Curry",
"category": [ "Analysis" ],
"dependencies": {
"flatcurry": ">= 1.0.0"
},
"compilerCompatibility": {
"pakcs": ">= 1.14.0, < 2.0.0",
......
......@@ -5,7 +5,8 @@
"synopsis": "CASS: the Curry Analysis Server System",
"category": [ "Analysis" ],
"dependencies": {
"cass-analysis": ">= 0.0.1"
"cass-analysis": ">= 0.0.1",
"flatcurry" : ">= 1.0.0"
},
"compilerCompatibility": {
"pakcs": ">= 1.14.0, < 2.0.0",
......
......@@ -5,6 +5,7 @@
"synopsis": "Libraries with various compile-time analyses for Curry",
"category": [ "Analysis" ],
"dependencies": {
"flatcurry": ">= 1.0.0"
},
"compilerCompatibility": {
"pakcs": ">= 1.14.0, < 2.0.0",
......
......@@ -5,6 +5,7 @@
"synopsis": "A tool to support automatic testing of Curry programs",
"category": [ "Testing" ],
"dependencies": {
"flatcurry" : ">= 1.0.0",
"rewriting" : ">= 0.0.1"
},
"compilerCompatibility": {
......
Copyright (c) 2017, Michael Hanus
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are
met:
1. Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
2. 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.
3. Neither the names of the copyright holders 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 COPYRIGHT HOLDERS AND 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 COPYRIGHT
HOLDER OR 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.
flatcurry
=========
This package contains libraries to deal with FlatCurry programs.
Currently, it contains the following modules:
* `FlatCurry.Compact`: This module contains operations to reduce the size
of FlatCurry programs by combining the main module and all imports
into a single program that contains only the functions directly or
indirectly called from a set of main functions.
* `FlatCurry.Files`: This module defines operations to read and write
FlatCurry programs.
* `FlatCurry.FlexRigid`: provides a function to compute the rigid/flex status
of a FlatCurry expression (right-hand side of a function definition).
* `FlatCurry.Goodies`: This library provides selector functions, test and
update operations as well as some useful auxiliary functions
for FlatCurry data terms.
* `FlatCurry.Pretty`: This library provides pretty-printers for
FlatCurry modules and all substructures (e.g., expressions).
* `FlatCurry.Read`: This library defines operations to read FlatCurry programs
or interfaces together with all its imported modules in the current
load path.
* `FlatCurry.Show`: This library contains operations to transform
FlatCurry programs into string representations, either in a
FlatCurry format or in a Curry-like syntax.
* `FlatCurry.Types`: This module defines the data types to represent
FlatCurry programs in Curry.
* `FlatCurry.XML`: This module contains operations to convert FlatCurry
programs into corresponding XML expressions and vice versa.
This can be used to store Curry programs in a way independent
of a Curry system or to use a Curry system, like PAKCS,
as back end by other functional logic programming systems.
{
"name": "flatcurry",
"version": "1.0.0",
"author": "Michael Hanus <mh@informatik.uni-kiel.de>",
"synopsis": "Libraries to deal with FlatCurry programs",
"category": [ "Metaprogramming" ],
"license": "BSD-3-Clause",
"licenseFile": "LICENSE",
"dependencies": {
"xml": ">= 0.0.1"
},
"compilerCompatibility": {
"pakcs": ">= 1.14.0, < 2.0.0",
"kics2": ">= 0.5.0, < 2.0.0"
},
"exportedModules": [ "FlatCurry.Compact", "FlatCurry.Files",
"FlatCurry.FlexRigid", "FlatCurry.Goodies",
"FlatCurry.Pretty", "FlatCurry.Read",
"FlatCurry.Show", "FlatCurry.Types",
"FlatCurry.XML" ],
"source": {
"git": "https://git.ps.informatik.uni-kiel.de/curry-packages/flatcurry.git",
"tag": "$version"
},
"testsuite": {
"src-dir": "test",
"modules": [ "testFlatCurryXML" ]
}
}
This diff is collapsed.
------------------------------------------------------------------------------
--- This library supports meta-programming, i.e., the manipulation of
--- Curry programs in Curry. This library defines I/O actions
--- to read Curry programs and transform them into this representation.
---
--- @author Michael Hanus
--- @version October 2015
--- @category meta
------------------------------------------------------------------------------
module FlatCurry.Files where
import Directory (doesFileExist)
import Distribution ( FrontendParams, FrontendTarget (..), defaultParams
, setQuiet, inCurrySubdir, stripCurrySuffix
, callFrontend, callFrontendWithParams
, lookupModuleSourceInLoadPath, getLoadPathForModule
)
import FileGoodies (getFileInPath, lookupFileInPath)
import FilePath (takeFileName, (</>), (<.>))
import FlatCurry.Types
import Maybe (isNothing)
import ReadShowTerm (readUnqualifiedTerm, showTerm)
--- I/O action which parses a Curry program and returns the corresponding
--- FlatCurry program.
--- Thus, the argument is the module path (without suffix ".curry"
--- or ".lcurry") and the result is a FlatCurry term representing this
--- program.
readFlatCurry :: String -> IO Prog
readFlatCurry progname =
readFlatCurryWithParseOptions progname (setQuiet True defaultParams)
--- I/O action which parses a Curry program
--- with respect to some parser options and returns the
--- corresponding FlatCurry program.
--- This I/O action is used by the standard action `readFlatCurry`.
--- @param progfile - the program file name (without suffix ".curry")
--- @param options - parameters passed to the front end
readFlatCurryWithParseOptions :: String -> FrontendParams -> IO Prog
readFlatCurryWithParseOptions progname options = do
mbsrc <- lookupModuleSourceInLoadPath progname
case mbsrc of
Nothing -> do -- no source file, try to find FlatCurry file in load path:
loadpath <- getLoadPathForModule progname
filename <- getFileInPath (flatCurryFileName (takeFileName progname)) [""]
loadpath
readFlatCurryFile filename
Just (dir,_) -> do
callFrontendWithParams FCY options progname
readFlatCurryFile (flatCurryFileName (dir </> takeFileName progname))
--- Transforms a name of a Curry program (with or without suffix ".curry"
--- or ".lcurry") into the name of the file containing the
--- corresponding FlatCurry program.
flatCurryFileName :: String -> String
flatCurryFileName prog = inCurrySubdir (stripCurrySuffix prog) <.> "fcy"
--- Transforms a name of a Curry program (with or without suffix ".curry"
--- or ".lcurry") into the name of the file containing the
--- corresponding FlatCurry program.
flatCurryIntName :: String -> String
flatCurryIntName prog = inCurrySubdir (stripCurrySuffix prog) <.> "fint"
--- I/O action which reads a FlatCurry program from a file in ".fcy" format.
--- In contrast to `readFlatCurry`, this action does not parse
--- a source program. Thus, the argument must be the name of an existing
--- file (with suffix ".fcy") containing a FlatCurry program in ".fcy"
--- format and the result is a FlatCurry term representing this program.
readFlatCurryFile :: String -> IO Prog
readFlatCurryFile filename = do
exfcy <- doesFileExist filename
if exfcy
then readExistingFCY filename
else do let subdirfilename = inCurrySubdir filename
exdirfcy <- doesFileExist subdirfilename
if exdirfcy
then readExistingFCY subdirfilename
else error ("EXISTENCE ERROR: FlatCurry file '" ++ filename ++
"' does not exist")
where
readExistingFCY fname = do
filecontents <- readFile fname
return (readUnqualifiedTerm ["FlatCurry.Types","Prelude"] filecontents)
--- I/O action which returns the interface of a Curry module, i.e.,
--- a FlatCurry program containing only "Public" entities and function
--- definitions without rules (i.e., external functions).
--- The argument is the file name without suffix ".curry"
--- (or ".lcurry") and the result is a FlatCurry term representing the
--- interface of this module.
readFlatCurryInt :: String -> IO Prog
readFlatCurryInt progname = do
readFlatCurryIntWithParseOptions progname (setQuiet True defaultParams)
--- I/O action which parses Curry program
--- with respect to some parser options and returns the FlatCurry
--- interface of this program, i.e.,
--- a FlatCurry program containing only "Public" entities and function
--- definitions without rules (i.e., external functions).
--- The argument is the file name without suffix ".curry"
--- (or ".lcurry") and the result is a FlatCurry term representing the
--- interface of this module.
readFlatCurryIntWithParseOptions :: String -> FrontendParams -> IO Prog
readFlatCurryIntWithParseOptions progname options = do
mbsrc <- lookupModuleSourceInLoadPath progname
case mbsrc of
Nothing -> do -- no source file, try to find FlatCurry file in load path:
loadpath <- getLoadPathForModule progname
filename <- getFileInPath (flatCurryIntName (takeFileName progname)) [""]
loadpath
readFlatCurryFile filename
Just (dir,_) -> do
callFrontendWithParams FINT options progname
readFlatCurryFile (flatCurryIntName (dir </> takeFileName progname))
--- Writes a FlatCurry program into a file in ".fcy" format.
--- The first argument must be the name of the target file
--- (with suffix ".fcy").
writeFCY :: String -> Prog -> IO ()
writeFCY file prog = writeFile file (showTerm prog)
--- Returns the name of the FlatCurry file of a module in the load path,
--- if this file exists.
lookupFlatCurryFileInLoadPath :: String -> IO (Maybe String)
lookupFlatCurryFileInLoadPath modname =
getLoadPathForModule modname >>=
lookupFileInPath (flatCurryFileName modname) [""]
--- Returns the name of the FlatCurry file of a module in the load path,
--- if this file exists.
getFlatCurryFileInLoadPath :: String -> IO String
getFlatCurryFileInLoadPath modname =
getLoadPathForModule modname >>=
getFileInPath (flatCurryFileName modname) [""]
------------------------------------------------------------------------------
--- This library provides a function to compute the rigid/flex status
--- of a FlatCurry expression (right-hand side of a function definition).
---
--- @author Michael Hanus
--- @version April 2005
------------------------------------------------------------------------------
module FlatCurry.FlexRigid(FlexRigidResult(..),getFlexRigid) where
import FlatCurry.Types
--- Datatype for representing a flex/rigid status of an expression.
data FlexRigidResult = UnknownFR | ConflictFR | KnownFlex | KnownRigid
--- Computes the rigid/flex status of a FlatCurry expression.
--- This function checks all cases in this expression.
--- If the expression has rigid as well as flex cases (which cannot
--- be the case for source level programs but might occur after
--- some program transformations), the result ConflictFR is returned.
getFlexRigid :: Expr -> FlexRigidResult
getFlexRigid (Var _) = UnknownFR
getFlexRigid (Lit _) = UnknownFR
getFlexRigid (Comb _ _ args) =
foldr joinCaseTypes UnknownFR (map getFlexRigid args)
getFlexRigid (Let _ e) = getFlexRigid e
getFlexRigid (Free _ e) = getFlexRigid e
getFlexRigid (Or e1 e2) =
joinCaseTypes (getFlexRigid e1) (getFlexRigid e2)
getFlexRigid (Case ctype e bs) =
foldr joinCaseTypes (if ctype==Flex then KnownFlex else KnownRigid)
(map getFlexRigid (e : map (\(Branch _ be)->be) bs))
getFlexRigid (Typed e _) = getFlexRigid e
joinCaseTypes ConflictFR ConflictFR = ConflictFR
joinCaseTypes ConflictFR UnknownFR = ConflictFR
joinCaseTypes ConflictFR KnownFlex = ConflictFR
joinCaseTypes ConflictFR KnownRigid = ConflictFR
joinCaseTypes UnknownFR ConflictFR = ConflictFR
joinCaseTypes KnownFlex ConflictFR = ConflictFR
joinCaseTypes KnownRigid ConflictFR = ConflictFR
joinCaseTypes UnknownFR UnknownFR = UnknownFR
joinCaseTypes UnknownFR KnownFlex = KnownFlex
joinCaseTypes UnknownFR KnownRigid = KnownRigid
joinCaseTypes KnownFlex UnknownFR = KnownFlex
joinCaseTypes KnownFlex KnownFlex = KnownFlex
joinCaseTypes KnownFlex KnownRigid = ConflictFR
joinCaseTypes KnownRigid UnknownFR = KnownRigid
joinCaseTypes KnownRigid KnownFlex = ConflictFR
joinCaseTypes KnownRigid KnownRigid = KnownRigid
This diff is collapsed.
--- --------------------------------------------------------------------------
--- This library provides pretty-printers for FlatCurry modules
--- and all substructures (e.g., expressions).
---
--- @author Bjoern Peemoeller
--- @version June 2015
--- --------------------------------------------------------------------------
module FlatCurry.Pretty where
import Pretty
import FlatCurry.Types
--- Options for pretty printing
--- @field indentWidth - number of columns for indentation of substructures
--- @field qualMode - Qualification mode of pretty printer
--- @field currentModule - Name of current module to be pretty-printed, used
--- for proper qualification
data Options = Options
{ indentWidth :: Int
, qualMode :: QualMode
, currentModule :: String
}
--- Qualification mode, determines whether identifiers are printed qualified
--- or unqualified. While `QualNone` and `QualImports` aim at readability,
--- there may be ambiguities due to shadowing. On the contrary, `QualImports`
--- and `QualAll` produce correct output at the cost of readability.
---
--- @cons QualNone - no qualification, only unqualified names
--- @cons QualImportsButPrelude - qualify all imports except those from
--- the module `Prelude`
--- @cons QualImports - qualify all imports, including `Prelude`
--- @cons QualAll - qualify all names
data QualMode = QualNone | QualImportsButPrelude | QualImports | QualAll
--- Default `Options` for pretty-printing.
defaultOptions :: Options
defaultOptions = Options
{ indentWidth = 2
, qualMode = QualImportsButPrelude
, currentModule = ""
}
-- ---------------------------------------------------------------------------
-- Pretty printing of Flat modules
-- ---------------------------------------------------------------------------
--- pretty-print a FlatCurry module
ppProg :: Options -> Prog -> Doc
ppProg o (Prog m is ts fs os) = vsepBlank
[ ppHeader o' m ts fs
, ppImports o' is
, ppOpDecls o' os
, ppTypeDecls o' ts
, ppFuncDecls o' fs
]
where o' = o { currentModule = m }
--- pretty-print the module header
ppHeader :: Options -> String -> [TypeDecl] -> [FuncDecl] -> Doc
ppHeader o m ts fs = indent o $
sep [text "module" <+> text m, ppExports o ts fs, text "where"]
--- pretty-print the export list
ppExports :: Options -> [TypeDecl] -> [FuncDecl] -> Doc
ppExports o ts fs = tupledSpaced (map (ppTypeExport o) ts ++ ppFuncExports o fs)
--- pretty-print a type export
ppTypeExport :: Options -> TypeDecl -> Doc
ppTypeExport o (Type qn vis _ cs)
| vis == Private = empty
| null cs = ppPrefixQOp o qn
| all isPublicCons cs = ppPrefixQOp o qn <+> text "(..)"
| otherwise = ppPrefixQOp o qn <+> tupled (ppConsExports o cs)
where isPublicCons (Cons _ _ v _) = v == Public
ppTypeExport o (TypeSyn qn vis _ _ )
| vis == Private = empty
| otherwise = ppPrefixQOp o qn
--- pretty-print the export list of constructors
ppConsExports :: Options -> [ConsDecl] -> [Doc]
ppConsExports o cs = [ ppPrefixQOp o qn | Cons qn _ Public _ <- cs]
--- pretty-print the export list of functions
ppFuncExports :: Options -> [FuncDecl] -> [Doc]
ppFuncExports o fs = [ ppPrefixQOp o qn | Func qn _ Public _ _ <- fs]
--- pretty-print a list of import statements
ppImports :: Options -> [String] -> Doc
ppImports o = vsep . map (ppImport o)
--- pretty-print a single import statement
ppImport :: Options -> String -> Doc
ppImport o m = indent o $ text "import" <+> text m
--- pretty-print a list of operator fixity declarations
ppOpDecls :: Options -> [OpDecl] -> Doc
ppOpDecls o = vsep . map (ppOpDecl o)
--- pretty-print a single operator fixity declaration
ppOpDecl :: Options -> OpDecl -> Doc
ppOpDecl o (Op qn fix n) = indent o $ ppFixity fix <+> int n <+> ppInfixQOp o qn
--- pretty-print the associativity keyword
ppFixity :: Fixity -> Doc
ppFixity InfixOp = text "infix"
ppFixity InfixlOp = text "infixl"
ppFixity InfixrOp = text "infixr"
--- pretty-print a list of type declarations
ppTypeDecls :: Options -> [TypeDecl] -> Doc
ppTypeDecls o = vsepBlank . map (ppTypeDecl o)
--- pretty-print a type declaration
ppTypeDecl :: Options -> TypeDecl -> Doc
ppTypeDecl o (Type qn _ vs cs) = indent o $ (text "data" <+> ppName qn
<+> hsep (empty : map ppTVarIndex vs)) $$ ppConsDecls o cs
ppTypeDecl o (TypeSyn qn _ vs ty) = indent o $ text "type" <+> ppName qn
<+> hsep (empty : map ppTVarIndex vs) </> equals <+> ppTypeExp o ty
--- pretty-print the constructor declarations
ppConsDecls :: Options -> [ConsDecl] -> Doc
ppConsDecls o cs = vsep $ zipWith (<+>) (equals : repeat bar)
(map (ppConsDecl o) cs)
--- pretty print a single constructor
ppConsDecl :: Options -> ConsDecl -> Doc
ppConsDecl o (Cons qn _ _ tys) = hsep $ ppPrefixOp qn : map (ppTypeExpr o 2) tys
--- pretty a top-level type expression
ppTypeExp :: Options -> TypeExpr -> Doc
ppTypeExp o = ppTypeExpr o 0
--- pretty-print a type expression
ppTypeExpr :: Options -> Int -> TypeExpr -> Doc
ppTypeExpr _ _ (TVar v) = ppTVarIndex v
ppTypeExpr o p (FuncType ty1 ty2) = parensIf (p > 0) $
ppTypeExpr o 1 ty1 </> rarrow <+> ppTypeExp o ty2
ppTypeExpr o p (TCons qn tys)
| isListId qn && length tys == 1 = brackets (ppTypeExp o (head tys))
| isTupleId qn = tupled (map (ppTypeExp o) tys)
| otherwise = parensIf (p > 1 && not (null tys)) $ sep
(ppPrefixQOp o qn : map (ppTypeExpr o 2) tys)
--- pretty-print a type variable
ppTVarIndex :: TVarIndex -> Doc
ppTVarIndex i = text $ vars !! i
where vars = [ chr c : if n == 0 then [] else show n
| n <- [0 ..], c <- [ord 'a' .. ord 'z']
]
--- pretty-print a list of function declarations
ppFuncDecls :: Options -> [FuncDecl] -> Doc
ppFuncDecls o = vsepBlank . map (ppFuncDecl o)
--- pretty-print a function declaration
ppFuncDecl :: Options -> FuncDecl -> Doc
ppFuncDecl o (Func qn _ _ ty r)
= indent o (sep [ppPrefixOp qn, text "::", ppTypeExp o ty])
$$ indent o (ppPrefixOp qn <+> ppRule o r)
--- pretty-print a function rule
ppRule :: Options -> Rule -> Doc
ppRule o (Rule vs e)
| null vs = equals <+> ppExp o e
| otherwise = hsep (map ppVarIndex vs) </> equals <+> ppExp o e
ppRule _ (External e) = text "external" <+> dquotes (text e)
--- Pretty-print a top-level expression.
ppExp :: Options -> Expr -> Doc
ppExp o = ppExpr o 0
--- pretty-print an expression
ppExpr :: Options -> Int -> Expr -> Doc
ppExpr _ _ (Var v) = ppVarIndex v
ppExpr _ _ (Lit l) = ppLiteral l
ppExpr o p (Comb _ qn es) = ppComb o p qn es
ppExpr o p (Free vs e)
| null vs = ppExpr o p e
| otherwise = parensIf (p > 0) $ sep
[ text "let"
<+> sep (punctuate comma (map ppVarIndex vs))
<+> text "free"
, text "in" </> ppExp o e
]
ppExpr o p (Let ds e) = parensIf (p > 0) $ sep
[ text "let" <+> ppDecls o ds
, text "in" <+> ppExp o e
]
ppExpr o p (Or e1 e2) = parensIf (p > 0)
$ ppExpr o 1 e1 <+> text "?" <+> ppExpr o 1 e2
ppExpr o p (Case ct e bs) = parensIf (p > 0) $ indent o
$ ppCaseType ct <+> ppExpr o 1 e <+> text "of"
$$ vsep (map (ppBranch o) bs)
ppExpr o p (Typed e ty) = parensIf (p > 0)
$ ppExp o e <+> text "::" <+> ppTypeExp o ty
--- pretty-print a variable
ppVarIndex :: VarIndex -> Doc
ppVarIndex i | i < 0 = text $ 'x' : show (negate i)
| otherwise = text $ 'v' : show i
--- pretty-print a literal
ppLiteral :: Literal -> Doc
ppLiteral (Intc i) = int i
ppLiteral (Floatc f) = float f
ppLiteral (Charc c) = text (show c)
--- Pretty print a constructor or function call
ppComb :: Options -> Int -> QName -> [Expr] -> Doc
ppComb o p qn es | isListId qn && null es = text "[]"
| isTupleId qn = tupled (map (ppExp o) es)
| otherwise = case es of
[] -> ppPrefixQOp o qn
[e1,e2]
| isInfixOp qn -> parensIf (p > 0)
$ fillSep [ppExpr o 1 e1, ppInfixQOp o qn, ppExpr o 1 e2]
_ -> parensIf (p > 0)
$ fillSep (ppPrefixQOp o qn : map (ppExpr o 1) es)
--- pretty-print a list of declarations
ppDecls :: Options -> [(VarIndex, Expr)] -> Doc
ppDecls o = align . vsep . map (ppDecl o)
--- pretty-print a single declaration
ppDecl :: Options -> (VarIndex, Expr) -> Doc
ppDecl o (v, e) = ppVarIndex v <+> equals <+> ppExp o e
--- Pretty print the type of a case expression
ppCaseType :: CaseType -> Doc
ppCaseType Rigid = text "case"
ppCaseType Flex = text "fcase"
--- Pretty print a case branch
ppBranch :: Options -> BranchExpr -> Doc
ppBranch o (Branch p e) = ppPattern o p <+> rarrow <+> indent o (ppExp o e)
--- Pretty print a pattern
ppPattern :: Options -> Pattern -> Doc
ppPattern o (Pattern c vs)
| isListId c && null vs = text "[]"
| isTupleId c = tupled (map ppVarIndex vs)
| otherwise = case vs of
[v1,v2] | isInfixOp c -> ppVarIndex v1 <+> ppInfixQOp o c <+> ppVarIndex v2
_ -> hsep (ppPrefixQOp o c : map ppVarIndex vs)
ppPattern _ (LPattern l) = ppLiteral l
-- ---------------------------------------------------------------------------
-- Names