Skip to content
GitLab
Menu
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
curry
curry-frontend
Commits
50d60cf5
Commit
50d60cf5
authored
Jun 21, 2011
by
Björn Peemöller
Browse files
Merge branch 'master' of /home/bjp/public_html/repos/curry-frontend
parents
62f8f62f
d0526478
Changes
16
Expand all
Show whitespace changes
Inline
Side-by-side
curry-frontend.cabal
View file @
50d60cf5
...
...
@@ -53,17 +53,6 @@ Executable cymake
, Check.SyntaxCheck
, Check.TypeCheck
, Check.WarnCheck
, Curry.IL
, Curry.IL.Pretty
, Curry.IL.Type
, Curry.IL.XML
, Curry.Syntax
, Curry.Syntax.Lexer
, Curry.Syntax.Parser
, Curry.Syntax.Pretty
, Curry.Syntax.ShowModule
, Curry.Syntax.Type
, Curry.Syntax.Utils
, Env.CurryEnv
, Env.NestEnv
, Env.OldScopeEnv
...
...
@@ -73,6 +62,10 @@ Executable cymake
, Gen.GenFlatCurry
, Html.CurryHtml
, Html.SyntaxColoring
, IL
, IL.Pretty
, IL.Type
, IL.XML
, CurryBuilder
, CompilerOpts
, CurryDeps
...
...
src/Curry/Syntax.hs
deleted
100644 → 0
View file @
62f8f62f
{- |A simple interface for reading and manipulating Curry source code.
(c) 2009, Holger Siegel
2011, Björn Peemöller
-}
module
Curry.Syntax
(
module
Curry
.
Syntax
.
Type
,
module
Curry
.
Syntax
.
Utils
,
lexFile
,
parseHeader
,
parseModule
,
ppModule
,
ppIDecl
,
showModule
)
where
import
Curry.Base.Position
(
Position
,
first
)
import
Curry.Base.MessageMonad
(
MsgMonad
)
import
Curry.Files.Unlit
(
unlit
)
import
qualified
Curry.Syntax.Lexer
as
Lexer
(
Token
,
lexFile
)
import
qualified
Curry.Syntax.Parser
as
Parser
(
parseHeader
,
parseSource
)
import
Curry.Syntax.Pretty
(
ppModule
,
ppIDecl
)
import
Curry.Syntax.ShowModule
(
showModule
)
import
Curry.Syntax.Type
import
Curry.Syntax.Utils
{- |Return the result of a lexical analysis of the source program 'src'.
The result is a list of tuples consisting of a 'Position' and a 'Token'
-}
lexFile
::
FilePath
->
String
->
MsgMonad
[(
Position
,
Lexer
.
Token
)]
lexFile
fn
src
=
unlit
fn
src
>>=
\
s
->
Lexer
.
lexFile
(
first
fn
)
s
False
[]
-- | Parse a curry header
parseHeader
::
FilePath
->
String
->
MsgMonad
Module
parseHeader
fn
src
=
unlit
fn
src
>>=
Parser
.
parseHeader
fn
-- | Parse a curry module
parseModule
::
Bool
->
FilePath
->
String
->
MsgMonad
Module
parseModule
likeFlat
fn
src
=
unlit
fn
src
>>=
Parser
.
parseSource
likeFlat
fn
src/Curry/Syntax/Lexer.lhs
deleted
100644 → 0
View file @
62f8f62f
This diff is collapsed.
Click to expand it.
src/Curry/Syntax/Parser.lhs
deleted
100644 → 0
View file @
62f8f62f
This diff is collapsed.
Click to expand it.
src/Curry/Syntax/Pretty.lhs
deleted
100644 → 0
View file @
62f8f62f
% $Id: CurryPP.lhs,v 1.50 2004/02/15 22:10:27 wlux Exp $
%
% Copyright (c) 1999-2004, Wolfgang Lux
% See LICENSE for the full license.
%
% Modified by Martin Engelke (men@informatik.uni-kiel.de)
%
\nwfilename{CurryPP.lhs}
\section{A Pretty Printer for Curry}\label{sec:CurryPP}
This module implements a pretty printer for Curry expressions. It was
derived from the Haskell pretty printer provided in Simon Marlow's
Haskell parser.
\begin{verbatim}
>
module
Curry.Syntax.Pretty
>
(
ppModule
,
ppIDecl
,
ppDecl
,
ppIdent
,
ppConstrTerm
,
ppFieldPatt
,
ppExpr
>
,
ppOp
,
ppStmt
,
ppFieldExpr
,
ppTypeExpr
,
ppAlt
>
)
where
>
import
Text.PrettyPrint.HughesPJ
>
import
Curry.Base.Ident
>
import
Curry.Syntax.Type
\end{verbatim}
Pretty print a module
\begin{verbatim}
>
ppModule
::
Module
->
Doc
>
ppModule
(
Module
m
es
ds
)
=
ppModuleHeader
m
es
$$
ppBlock
ds
\end{verbatim}
Module header
\begin{verbatim}
>
ppModuleHeader
::
ModuleIdent
->
Maybe
ExportSpec
->
Doc
>
ppModuleHeader
m
es
=
>
text
"module"
<+>
ppMIdent
m
<+>
maybePP
ppExportSpec
es
<+>
text
"where"
>
ppExportSpec
::
ExportSpec
->
Doc
>
ppExportSpec
(
Exporting
_
es
)
=
parenList
(
map
ppExport
es
)
>
ppExport
::
Export
->
Doc
>
ppExport
(
Export
x
)
=
ppQIdent
x
>
ppExport
(
ExportTypeWith
tc
cs
)
=
ppQIdent
tc
<>
parenList
(
map
ppIdent
cs
)
>
ppExport
(
ExportTypeAll
tc
)
=
ppQIdent
tc
<>
text
"(..)"
>
ppExport
(
ExportModule
m
)
=
text
"module"
<+>
ppMIdent
m
\end{verbatim}
Declarations
\begin{verbatim}
>
ppBlock
::
[
Decl
]
->
Doc
>
ppBlock
=
vcat
.
map
ppDecl
>
ppDecl
::
Decl
->
Doc
>
ppDecl
(
ImportDecl
_
m
q
asM
is
)
=
>
text
"import"
<+>
ppQualified
q
<+>
ppMIdent
m
<+>
maybePP
ppAs
asM
>
<+>
maybePP
ppImportSpec
is
>
where
ppQualified
q'
=
if
q'
then
text
"qualified"
else
empty
>
ppAs
m'
=
text
"as"
<+>
ppMIdent
m'
>
ppDecl
(
InfixDecl
_
fix
p
ops
)
=
ppPrec
fix
p
<+>
list
(
map
ppInfixOp
ops
)
>
ppDecl
(
DataDecl
_
tc
tvs
cs
)
=
>
sep
(
ppTypeDeclLhs
"data"
tc
tvs
:
>
map
indent
(
zipWith
(
<+>
)
(
equals
:
repeat
vbar
)
(
map
ppConstr
cs
)))
>
ppDecl
(
NewtypeDecl
_
tc
tvs
nc
)
=
>
sep
[
ppTypeDeclLhs
"newtype"
tc
tvs
<+>
equals
,
indent
(
ppNewConstr
nc
)]
>
ppDecl
(
TypeDecl
_
tc
tvs
ty
)
=
>
sep
[
ppTypeDeclLhs
"type"
tc
tvs
<+>
equals
,
indent
(
ppTypeExpr
0
ty
)]
>
ppDecl
(
TypeSig
_
fs
ty
)
=
>
list
(
map
ppIdent
fs
)
<+>
text
"::"
<+>
ppTypeExpr
0
ty
>
ppDecl
(
EvalAnnot
_
fs
ev
)
=
>
list
(
map
ppIdent
fs
)
<+>
text
"eval"
<+>
ppEval
ev
>
where
ppEval
EvalRigid
=
text
"rigid"
>
ppEval
EvalChoice
=
text
"choice"
>
ppDecl
(
FunctionDecl
_
_
eqs
)
=
vcat
(
map
ppEquation
eqs
)
>
ppDecl
(
ExternalDecl
p
cc
impent
f
ty
)
=
>
sep
[
text
"external"
<+>
ppCallConv
cc
<+>
maybePP
(
text
.
show
)
impent
,
>
indent
(
ppDecl
(
TypeSig
p
[
f
]
ty
))]
>
where
ppCallConv
CallConvPrimitive
=
text
"primitive"
>
ppCallConv
CallConvCCall
=
text
"ccall"
>
ppDecl
(
FlatExternalDecl
_
fs
)
=
list
(
map
ppIdent
fs
)
<+>
text
"external"
>
ppDecl
(
PatternDecl
_
t
rhs
)
=
ppRule
(
ppConstrTerm
0
t
)
equals
rhs
>
ppDecl
(
ExtraVariables
_
vs
)
=
list
(
map
ppIdent
vs
)
<+>
text
"free"
>
ppImportSpec
::
ImportSpec
->
Doc
>
ppImportSpec
(
Importing
_
is
)
=
parenList
(
map
ppImport
is
)
>
ppImportSpec
(
Hiding
_
is
)
=
text
"hiding"
<+>
parenList
(
map
ppImport
is
)
>
ppImport
::
Import
->
Doc
>
ppImport
(
Import
x
)
=
ppIdent
x
>
ppImport
(
ImportTypeWith
tc
cs
)
=
ppIdent
tc
<>
parenList
(
map
ppIdent
cs
)
>
ppImport
(
ImportTypeAll
tc
)
=
ppIdent
tc
<>
text
"(..)"
>
ppPrec
::
Infix
->
Integer
->
Doc
>
ppPrec
fix
p
=
ppAssoc
fix
<+>
ppPrio
p
>
where
ppAssoc
InfixL
=
text
"infixl"
>
ppAssoc
InfixR
=
text
"infixr"
>
ppAssoc
Infix
=
text
"infix"
>
ppPrio
p'
=
if
p'
<
0
then
empty
else
integer
p'
>
ppTypeDeclLhs
::
String
->
Ident
->
[
Ident
]
->
Doc
>
ppTypeDeclLhs
kw
tc
tvs
=
text
kw
<+>
ppIdent
tc
<+>
hsep
(
map
ppIdent
tvs
)
>
ppConstr
::
ConstrDecl
->
Doc
>
ppConstr
(
ConstrDecl
_
tvs
c
tys
)
=
>
sep
[
ppExistVars
tvs
,
ppIdent
c
<+>
fsep
(
map
(
ppTypeExpr
2
)
tys
)]
>
ppConstr
(
ConOpDecl
_
tvs
ty1
op
ty2
)
=
>
sep
[
ppExistVars
tvs
,
ppTypeExpr
1
ty1
,
ppInfixOp
op
<+>
ppTypeExpr
1
ty2
]
>
ppNewConstr
::
NewConstrDecl
->
Doc
>
ppNewConstr
(
NewConstrDecl
_
tvs
c
ty
)
=
>
sep
[
ppExistVars
tvs
,
ppIdent
c
<+>
ppTypeExpr
2
ty
]
>
ppExistVars
::
[
Ident
]
->
Doc
>
ppExistVars
tvs
>
|
null
tvs
=
empty
>
|
otherwise
=
text
"forall"
<+>
hsep
(
map
ppIdent
tvs
)
<+>
char
'.'
>
ppEquation
::
Equation
->
Doc
>
ppEquation
(
Equation
_
lhs
rhs
)
=
ppRule
(
ppLhs
lhs
)
equals
rhs
>
ppLhs
::
Lhs
->
Doc
>
ppLhs
(
FunLhs
f
ts
)
=
ppIdent
f
<+>
fsep
(
map
(
ppConstrTerm
2
)
ts
)
>
ppLhs
(
OpLhs
t1
f
t2
)
=
>
ppConstrTerm
1
t1
<+>
ppInfixOp
f
<+>
ppConstrTerm
1
t2
>
ppLhs
(
ApLhs
lhs
ts
)
=
parens
(
ppLhs
lhs
)
<+>
fsep
(
map
(
ppConstrTerm
2
)
ts
)
>
ppRule
::
Doc
->
Doc
->
Rhs
->
Doc
>
ppRule
lhs
eq
(
SimpleRhs
_
e
ds
)
=
>
sep
[
lhs
<+>
eq
,
indent
(
ppExpr
0
e
)]
$$
ppLocalDefs
ds
>
ppRule
lhs
eq
(
GuardedRhs
es
ds
)
=
>
sep
[
lhs
,
indent
(
vcat
(
map
(
ppCondExpr
eq
)
es
))]
$$
ppLocalDefs
ds
>
ppLocalDefs
::
[
Decl
]
->
Doc
>
ppLocalDefs
ds
>
|
null
ds
=
empty
>
|
otherwise
=
indent
(
text
"where"
<+>
ppBlock
ds
)
\end{verbatim}
Interfaces
\begin{verbatim}
ppInterface :: Interface -> Doc
ppInterface (Interface m ds) =
text "interface" <+> ppMIdent m <+> text "where" <+> lbrace
$$ vcat (punctuate semi (map ppIDecl ds)) $$ rbrace
>
ppIDecl
::
IDecl
->
Doc
>
ppIDecl
(
IImportDecl
_
m
)
=
text
"import"
<+>
ppMIdent
m
>
ppIDecl
(
IInfixDecl
_
fix
p
op
)
=
ppPrec
fix
p
<+>
ppQInfixOp
op
>
ppIDecl
(
HidingDataDecl
_
tc
tvs
)
=
>
text
"hiding"
<+>
ppITypeDeclLhs
"data"
(
qualify
tc
)
tvs
>
ppIDecl
(
IDataDecl
_
tc
tvs
cs
)
=
>
sep
(
ppITypeDeclLhs
"data"
tc
tvs
:
>
map
indent
(
zipWith
(
<+>
)
(
equals
:
repeat
vbar
)
(
map
ppIConstr
cs
)))
>
where
ppIConstr
=
maybe
(
char
'_'
)
ppConstr
>
ppIDecl
(
INewtypeDecl
_
tc
tvs
nc
)
=
>
sep
[
ppITypeDeclLhs
"newtype"
tc
tvs
<+>
equals
,
indent
(
ppNewConstr
nc
)]
>
ppIDecl
(
ITypeDecl
_
tc
tvs
ty
)
=
>
sep
[
ppITypeDeclLhs
"type"
tc
tvs
<+>
equals
,
indent
(
ppTypeExpr
0
ty
)]
>
ppIDecl
(
IFunctionDecl
_
f
_
ty
)
=
ppQIdent
f
<+>
text
"::"
<+>
ppTypeExpr
0
ty
>
ppITypeDeclLhs
::
String
->
QualIdent
->
[
Ident
]
->
Doc
>
ppITypeDeclLhs
kw
tc
tvs
=
text
kw
<+>
ppQIdent
tc
<+>
hsep
(
map
ppIdent
tvs
)
\end{verbatim}
Types
\begin{verbatim}
>
ppTypeExpr
::
Int
->
TypeExpr
->
Doc
>
ppTypeExpr
p
(
ConstructorType
tc
tys
)
=
>
parenExp
(
p
>
1
&&
not
(
null
tys
))
>
(
ppQIdent
tc
<+>
fsep
(
map
(
ppTypeExpr
2
)
tys
))
>
ppTypeExpr
_
(
VariableType
tv
)
=
ppIdent
tv
>
ppTypeExpr
_
(
TupleType
tys
)
=
parenList
(
map
(
ppTypeExpr
0
)
tys
)
>
ppTypeExpr
_
(
ListType
ty
)
=
brackets
(
ppTypeExpr
0
ty
)
>
ppTypeExpr
p
(
ArrowType
ty1
ty2
)
=
>
parenExp
(
p
>
0
)
(
fsep
(
ppArrowType
(
ArrowType
ty1
ty2
)))
>
where
ppArrowType
(
ArrowType
ty1'
ty2'
)
=
>
ppTypeExpr
1
ty1'
<+>
rarrow
:
ppArrowType
ty2'
>
ppArrowType
ty
=
[
ppTypeExpr
0
ty
]
>
ppTypeExpr
_
(
RecordType
fs
rty
)
=
>
braces
(
list
(
map
ppTypedField
fs
)
>
<>
maybe
empty
(
\
ty
->
space
<>
char
'|'
<+>
ppTypeExpr
0
ty
)
rty
)
>
where
>
ppTypedField
(
ls
,
ty
)
=
>
list
(
map
ppIdent
ls
)
<>
text
"::"
<>
ppTypeExpr
0
ty
\end{verbatim}
Literals
\begin{verbatim}
>
ppLiteral
::
Literal
->
Doc
>
ppLiteral
(
Char
_
c
)
=
text
(
show
c
)
>
ppLiteral
(
Int
_
i
)
=
integer
i
>
ppLiteral
(
Float
_
f
)
=
double
f
>
ppLiteral
(
String
_
s
)
=
text
(
show
s
)
\end{verbatim}
Patterns
\begin{verbatim}
>
ppConstrTerm
::
Int
->
ConstrTerm
->
Doc
>
ppConstrTerm
p
(
LiteralPattern
l
)
=
>
parenExp
(
p
>
1
&&
isNegative
l
)
(
ppLiteral
l
)
>
where
isNegative
(
Char
_
_
)
=
False
>
isNegative
(
Int
_
i
)
=
i
<
0
>
isNegative
(
Float
_
f
)
=
f
<
0.0
>
isNegative
(
String
_
_
)
=
False
>
ppConstrTerm
p
(
NegativePattern
op
l
)
=
>
parenExp
(
p
>
1
)
(
ppInfixOp
op
<>
ppLiteral
l
)
>
ppConstrTerm
_
(
VariablePattern
v
)
=
ppIdent
v
>
ppConstrTerm
p
(
ConstructorPattern
c
ts
)
=
>
parenExp
(
p
>
1
&&
not
(
null
ts
))
>
(
ppQIdent
c
<+>
fsep
(
map
(
ppConstrTerm
2
)
ts
))
>
ppConstrTerm
p
(
InfixPattern
t1
c
t2
)
=
>
parenExp
(
p
>
0
)
>
(
sep
[
ppConstrTerm
1
t1
<+>
ppQInfixOp
c
,
>
indent
(
ppConstrTerm
0
t2
)])
>
ppConstrTerm
_
(
ParenPattern
t
)
=
parens
(
ppConstrTerm
0
t
)
>
ppConstrTerm
_
(
TuplePattern
_
ts
)
=
parenList
(
map
(
ppConstrTerm
0
)
ts
)
>
ppConstrTerm
_
(
ListPattern
_
ts
)
=
bracketList
(
map
(
ppConstrTerm
0
)
ts
)
>
ppConstrTerm
_
(
AsPattern
v
t
)
=
ppIdent
v
<>
char
'@'
<>
ppConstrTerm
2
t
>
ppConstrTerm
_
(
LazyPattern
_
t
)
=
char
'~'
<>
ppConstrTerm
2
t
>
ppConstrTerm
p
(
FunctionPattern
f
ts
)
=
>
parenExp
(
p
>
1
&&
not
(
null
ts
))
>
(
ppQIdent
f
<+>
fsep
(
map
(
ppConstrTerm
2
)
ts
))
>
ppConstrTerm
p
(
InfixFuncPattern
t1
f
t2
)
=
>
parenExp
(
p
>
0
)
>
(
sep
[
ppConstrTerm
1
t1
<+>
ppQInfixOp
f
,
>
indent
(
ppConstrTerm
0
t2
)])
>
ppConstrTerm
_
(
RecordPattern
fs
rt
)
=
>
braces
(
list
(
map
ppFieldPatt
fs
)
>
<>
(
maybe
empty
(
\
t
->
space
<>
char
'|'
<+>
ppConstrTerm
0
t
)
rt
))
>
ppFieldPatt
::
Field
ConstrTerm
->
Doc
>
ppFieldPatt
(
Field
_
l
t
)
=
ppIdent
l
<>
equals
<>
ppConstrTerm
0
t
\end{verbatim}
Expressions
\begin{verbatim}
>
ppCondExpr
::
Doc
->
CondExpr
->
Doc
>
ppCondExpr
eq
(
CondExpr
_
g
e
)
=
>
vbar
<+>
sep
[
ppExpr
0
g
<+>
eq
,
indent
(
ppExpr
0
e
)]
>
ppExpr
::
Int
->
Expression
->
Doc
>
ppExpr
_
(
Literal
l
)
=
ppLiteral
l
>
ppExpr
_
(
Variable
v
)
=
ppQIdent
v
>
ppExpr
_
(
Constructor
c
)
=
ppQIdent
c
>
ppExpr
_
(
Paren
e
)
=
parens
(
ppExpr
0
e
)
>
ppExpr
p
(
Typed
e
ty
)
=
>
parenExp
(
p
>
0
)
(
ppExpr
0
e
<+>
text
"::"
<+>
ppTypeExpr
0
ty
)
>
ppExpr
_
(
Tuple
_
es
)
=
parenList
(
map
(
ppExpr
0
)
es
)
>
ppExpr
_
(
List
_
es
)
=
bracketList
(
map
(
ppExpr
0
)
es
)
>
ppExpr
_
(
ListCompr
_
e
qs
)
=
>
brackets
(
ppExpr
0
e
<+>
vbar
<+>
list
(
map
ppStmt
qs
))
>
ppExpr
_
(
EnumFrom
e
)
=
brackets
(
ppExpr
0
e
<+>
text
".."
)
>
ppExpr
_
(
EnumFromThen
e1
e2
)
=
>
brackets
(
ppExpr
0
e1
<>
comma
<+>
ppExpr
0
e2
<+>
text
".."
)
>
ppExpr
_
(
EnumFromTo
e1
e2
)
=
>
brackets
(
ppExpr
0
e1
<+>
text
".."
<+>
ppExpr
0
e2
)
>
ppExpr
_
(
EnumFromThenTo
e1
e2
e3
)
=
>
brackets
(
ppExpr
0
e1
<>
comma
<+>
ppExpr
0
e2
>
<+>
text
".."
<+>
ppExpr
0
e3
)
>
ppExpr
p
(
UnaryMinus
op
e
)
=
parenExp
(
p
>
1
)
(
ppInfixOp
op
<>
ppExpr
1
e
)
>
ppExpr
p
(
Apply
e1
e2
)
=
>
parenExp
(
p
>
1
)
(
sep
[
ppExpr
1
e1
,
indent
(
ppExpr
2
e2
)])
>
ppExpr
p
(
InfixApply
e1
op
e2
)
=
>
parenExp
(
p
>
0
)
(
sep
[
ppExpr
1
e1
<+>
ppQInfixOp
(
opName
op
),
>
indent
(
ppExpr
1
e2
)])
>
ppExpr
_
(
LeftSection
e
op
)
=
parens
(
ppExpr
1
e
<+>
ppQInfixOp
(
opName
op
))
>
ppExpr
_
(
RightSection
op
e
)
=
parens
(
ppQInfixOp
(
opName
op
)
<+>
ppExpr
1
e
)
>
ppExpr
p
(
Lambda
_
t
e
)
=
>
parenExp
(
p
>
0
)
>
(
sep
[
backsl
<>
fsep
(
map
(
ppConstrTerm
2
)
t
)
<+>
rarrow
,
>
indent
(
ppExpr
0
e
)])
>
ppExpr
p
(
Let
ds
e
)
=
>
parenExp
(
p
>
0
)
>
(
sep
[
text
"let"
<+>
ppBlock
ds
<+>
text
"in"
,
ppExpr
0
e
])
>
ppExpr
p
(
Do
sts
e
)
=
>
parenExp
(
p
>
0
)
(
text
"do"
<+>
(
vcat
(
map
ppStmt
sts
)
$$
ppExpr
0
e
))
>
ppExpr
p
(
IfThenElse
_
e1
e2
e3
)
=
>
parenExp
(
p
>
0
)
>
(
text
"if"
<+>
>
sep
[
ppExpr
0
e1
,
>
text
"then"
<+>
ppExpr
0
e2
,
>
text
"else"
<+>
ppExpr
0
e3
])
>
ppExpr
p
(
Case
_
e
alts
)
=
>
parenExp
(
p
>
0
)
>
(
text
"case"
<+>
ppExpr
0
e
<+>
text
"of"
$$
>
indent
(
vcat
(
map
ppAlt
alts
)))
>
ppExpr
_
(
RecordConstr
fs
)
=
>
braces
(
list
(
map
(
ppFieldExpr
equals
)
fs
))
>
ppExpr
p
(
RecordSelection
e
l
)
=
>
parenExp
(
p
>
0
)
>
(
ppExpr
1
e
<+>
text
"->"
<+>
ppIdent
l
)
>
ppExpr
_
(
RecordUpdate
fs
e
)
=
>
braces
(
list
(
map
(
ppFieldExpr
(
text
":="
))
fs
)
>
<+>
char
'|'
<+>
ppExpr
0
e
)
>
ppStmt
::
Statement
->
Doc
>
ppStmt
(
StmtExpr
_
e
)
=
ppExpr
0
e
>
ppStmt
(
StmtBind
_
t
e
)
=
sep
[
ppConstrTerm
0
t
<+>
larrow
,
indent
(
ppExpr
0
e
)]
>
ppStmt
(
StmtDecl
ds
)
=
text
"let"
<+>
ppBlock
ds
>
ppAlt
::
Alt
->
Doc
>
ppAlt
(
Alt
_
t
rhs
)
=
ppRule
(
ppConstrTerm
0
t
)
rarrow
rhs
>
ppFieldExpr
::
Doc
->
Field
Expression
->
Doc
>
ppFieldExpr
comb
(
Field
_
l
e
)
=
ppIdent
l
<>
comb
<>
ppExpr
0
e
>
ppOp
::
InfixOp
->
Doc
>
ppOp
(
InfixOp
op
)
=
ppQInfixOp
op
>
ppOp
(
InfixConstr
op
)
=
ppQInfixOp
op
\end{verbatim}
Names
\begin{verbatim}
>
ppIdent
::
Ident
->
Doc
>
ppIdent
x
=
parenExp
(
isInfixOp
x
)
(
text
(
name
x
))
>
ppQIdent
::
QualIdent
->
Doc
>
ppQIdent
x
=
parenExp
(
isQInfixOp
x
)
(
text
(
qualName
x
))
>
ppInfixOp
::
Ident
->
Doc
>
ppInfixOp
x
=
backQuoteExp
(
not
(
isInfixOp
x
))
(
text
(
name
x
))
>
ppQInfixOp
::
QualIdent
->
Doc
>
ppQInfixOp
x
=
backQuoteExp
(
not
(
isQInfixOp
x
))
(
text
(
qualName
x
))
>
ppMIdent
::
ModuleIdent
->
Doc
>
ppMIdent
m
=
text
(
moduleName
m
)
\end{verbatim}
Print printing utilities
\begin{verbatim}
>
indent
::
Doc
->
Doc
>
indent
=
nest
2
>
maybePP
::
(
a
->
Doc
)
->
Maybe
a
->
Doc
>
maybePP
pp
=
maybe
empty
pp
>
parenExp
::
Bool
->
Doc
->
Doc
>
parenExp
b
doc
=
if
b
then
parens
doc
else
doc
>
backQuoteExp
::
Bool
->
Doc
->
Doc
>
backQuoteExp
b
doc
=
if
b
then
backQuote
<>
doc
<>
backQuote
else
doc
>
list
,
parenList
,
bracketList
::
[
Doc
]
->
Doc
>
list
=
fsep
.
punctuate
comma
>
parenList
=
parens
.
list
>
bracketList
=
brackets
.
list
braceList :: [Doc] -> Doc
braceList = braces . list
>
backQuote
,
backsl
,
vbar
,
rarrow
,
larrow
::
Doc
>
backQuote
=
char
'`'
>
backsl
=
char
'
\\
'
>
vbar
=
char
'|'
>
rarrow
=
text
"->"
>
larrow
=
text
"<-"
\end{verbatim}
src/Curry/Syntax/ShowModule.hs
deleted
100644 → 0
View file @
62f8f62f
{- |Transform a CurrySyntax module into a string representation without any
pretty printing.
Behaves like a derived Show instance even on parts with a specific one.
@author Sebastian Fischer (sebf@informatik.uni-kiel.de)
@version December 2008
bug fixed by bbr
-}
module
Curry.Syntax.ShowModule
(
showModule
)
where
import
Curry.Base.Ident
import
Curry.Base.Position
import
Curry.Syntax.Type
showModule
::
Module
->
String
showModule
m
=
showsModule
m
"
\n
"
showsModule
::
Module
->
ShowS
showsModule
(
Module
mident
espec
decls
)
=
showsString
"Module "
.
showsModuleIdent
mident
.
newline
.
showsMaybe
showsExportSpec
espec
.
newline
.
showsList
(
\
d
->
showsDecl
d
.
newline
)
decls
showsPosition
::
Position
->
ShowS
showsPosition
Position
{
line
=
l
,
column
=
c
}
=
showsPair
shows
shows
(
l
,
c
)
showsPosition
_
=
id
-- showsPosition (Position file row col)
-- = showsString "(Position "
-- . shows file . space
-- . shows row . space
-- . shows col
-- . showsString ")"
showsExportSpec
::
ExportSpec
->
ShowS
showsExportSpec
(
Exporting
pos
exports
)
=
showsString
"(Exporting "
.
showsPosition
pos
.
space
.
showsList
showsExport
exports
.
showsString
")"
showsExport
::
Export
->
ShowS
showsExport
(
Export
qident
)
=
showsString
"(Export "
.
showsQualIdent
qident
.
showsString
")"
showsExport
(
ExportTypeWith
qident
ids
)
=
showsString
"(ExportTypeWith "
.
showsQualIdent
qident
.
space
.
showsList
showsIdent
ids
.
showsString
")"
showsExport
(
ExportTypeAll
qident
)
=
showsString
"(ExportTypeAll "
.
showsQualIdent
qident
.
showsString
")"
showsExport
(
ExportModule
m
)
=
showsString
"(ExportModule "
.
showsModuleIdent
m
.
showChar
')'
showsImportSpec
::
ImportSpec
->
ShowS
showsImportSpec
(
Importing
pos
imports
)
=
showsString
"(Importing "
.
showsPosition
pos
.
space
.
showsList
showsImport
imports
.
showsString
")"
showsImportSpec
(
Hiding
pos
imports
)
=
showsString
"(Hiding "
.
showsPosition
pos
.
space
.
showsList
showsImport
imports
.
showsString
")"
showsImport
::
Import
->
ShowS
showsImport
(
Import
ident
)
=
showsString
"(Import "
.
showsIdent
ident
.
showsString
")"
showsImport
(
ImportTypeWith
ident
idents
)
=
showsString
"(ImportTypeWith "
.
showsIdent
ident
.
space
.
showsList
showsIdent
idents
.
showsString
")"
showsImport
(
ImportTypeAll
ident
)
=
showsString
"(ImportTypeAll "
.
showsIdent
ident
.
showsString
")"
showsDecl
::
Decl
->
ShowS
showsDecl
(
ImportDecl
pos
mident
quali
mmident
mimpspec
)
=
showsString
"(ImportDecl "
.
showsPosition
pos
.
space
.
showsModuleIdent
mident
.
space
.
shows
quali
.
space
.
showsMaybe
showsModuleIdent
mmident
.
space
.
showsMaybe
showsImportSpec
mimpspec
.
showsString
")"
showsDecl
(
InfixDecl
pos
infx
prec
idents
)
=
showsString
"(InfixDecl "
.
showsPosition
pos
.
space
.
shows
infx
.
space
.
shows
prec
.
space
.
showsList
showsIdent
idents
.
showsString
")"
showsDecl
(
DataDecl
pos
ident
idents
consdecls
)
=
showsString
"(DataDecl "
.
showsPosition
pos
.
space
.
showsIdent
ident
.
space
.
showsList
showsIdent
idents
.
space
.
showsList
showsConsDecl
consdecls
.
showsString
")"
showsDecl
(
NewtypeDecl
pos
ident
idents
newconsdecl
)
=
showsString
"(NewtypeDecl "
.
showsPosition
pos
.
space
.
showsIdent
ident
.
space
.
showsList
showsIdent
idents
.
space
.
showsNewConsDecl
newconsdecl
.
showsString
")"
showsDecl
(
TypeDecl
pos
ident
idents
typ
)
=
showsString
"(TypeDecl "
.
showsPosition
pos
.
space
.
showsIdent
ident
.
space
.
showsList
showsIdent
idents
.
space
.
showsTypeExpr
typ
.
showsString
")"
showsDecl
(
TypeSig
pos
idents
typ
)
=
showsString
"(TypeSig "
.
showsPosition
pos
.
space
.
showsList
showsIdent
idents
.
space
.
showsTypeExpr
typ
.
showsString
")"
showsDecl
(
EvalAnnot
pos
idents
annot
)
=
showsString
"(EvalAnnot "
.
showsPosition
pos
.
space
.
showsList
showsIdent
idents
.
space
.
shows
annot
.
showsString
")"
showsDecl
(
FunctionDecl
pos
ident
eqs
)
=
showsString
"(FunctionDecl "
.
showsPosition
pos
.
space
.
showsIdent
ident
.
space
.
showsList
showsEquation
eqs
.
showsString
")"
showsDecl
(
ExternalDecl
pos
cconv
mstr
ident
typ
)
=
showsString
"(ExternalDecl "
.
showsPosition
pos
.
space
.
shows
cconv
.
space
.
shows
mstr
.
space
.
showsIdent
ident
.
space
.
showsTypeExpr
typ
.
showsString
")"
showsDecl
(
FlatExternalDecl
pos
idents
)
=
showsString
"(FlatExternalDecl "
.
showsPosition
pos
.
space
.
showsList
showsIdent
idents
.
showsString
")"
showsDecl
(
PatternDecl
pos
cons
rhs
)
=
showsString
"(PatternDecl "
.
showsPosition
pos
.
space