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
0c8dc9bc
Commit
0c8dc9bc
authored
Jul 09, 2015
by
Björn Peemöller
Browse files
Improved pretty-printing of intermediate language
parent
bbf700ec
Changes
1
Hide whitespace changes
Inline
Side-by-side
src/IL/Pretty.hs
View file @
0c8dc9bc
...
...
@@ -3,6 +3,7 @@
Description : Pretty printer for IL
Copyright : (c) 1999 - 2003 Wolfgang Lux
Martin Engelke
2011 - 2015 Björn Peemöller
License : OtherLicense
Maintainer : bjp@informatik.uni-kiel.de
...
...
@@ -80,12 +81,12 @@ ppType p (TypeConstructor tc tys)
|
isQTupleId
tc
=
parens
(
fsep
(
punctuate
comma
(
map
(
ppType
0
)
tys
)))
|
unqualify
tc
==
nilId
=
brackets
(
ppType
0
(
head
tys
))
|
otherwise
=
p
pP
aren
(
p
>
1
&&
not
(
null
tys
))
|
otherwise
=
paren
If
(
p
>
1
&&
not
(
null
tys
))
(
ppQIdent
tc
<+>
fsep
(
map
(
ppType
2
)
tys
))
ppType
_
(
TypeVariable
n
)
|
n
>=
0
=
text
(
typeVars
!!
n
)
|
otherwise
=
text
(
'_'
:
show
(
-
n
))
ppType
p
(
TypeArrow
ty1
ty2
)
=
p
pP
aren
(
p
>
0
)
ppType
p
(
TypeArrow
ty1
ty2
)
=
paren
If
(
p
>
0
)
(
fsep
(
ppArrow
(
TypeArrow
ty1
ty2
)))
where
ppArrow
(
TypeArrow
ty1'
ty2'
)
=
ppType
1
ty1'
<+>
text
"->"
:
ppArrow
ty2'
...
...
@@ -122,27 +123,27 @@ ppExpr p (Apply (Apply (Function f _) e1) e2)
|
isQInfixOp
f
=
ppInfixApp
p
e1
f
e2
ppExpr
p
(
Apply
(
Apply
(
Constructor
c
_
)
e1
)
e2
)
|
isQInfixOp
c
=
ppInfixApp
p
e1
c
e2
ppExpr
p
(
Apply
e1
e2
)
=
p
pP
aren
(
p
>
2
)
$
sep
ppExpr
p
(
Apply
e1
e2
)
=
paren
If
(
p
>
2
)
$
sep
[
ppExpr
2
e1
,
nest
exprIndent
(
ppExpr
3
e2
)]
ppExpr
p
(
Case
_
ev
e
alts
)
=
p
pP
aren
(
p
>
0
)
$
ppExpr
p
(
Case
_
ev
e
alts
)
=
paren
If
(
p
>
0
)
$
text
"case"
<+>
ppEval
ev
<+>
ppExpr
0
e
<+>
text
"of"
$$
nest
caseIndent
(
vcat
$
map
ppAlt
alts
)
where
ppEval
Rigid
=
text
"rigid"
ppEval
Flex
=
text
"flex"
ppExpr
p
(
Or
e1
e2
)
=
p
pP
aren
(
p
>
0
)
$
sep
ppExpr
p
(
Or
e1
e2
)
=
paren
If
(
p
>
0
)
$
sep
[
nest
orIndent
(
ppExpr
0
e1
),
char
'|'
,
nest
orIndent
(
ppExpr
0
e2
)]
ppExpr
p
(
Exist
v
e
)
=
p
pP
aren
(
p
>
0
)
$
sep
ppExpr
p
(
Exist
v
e
)
=
paren
If
(
p
>
0
)
$
sep
[
text
"let"
<+>
ppIdent
v
<+>
text
"free"
<+>
text
"in"
,
ppExpr
0
e
]
ppExpr
p
(
Let
b
e
)
=
p
pP
aren
(
p
>
0
)
$
sep
ppExpr
p
(
Let
b
e
)
=
paren
If
(
p
>
0
)
$
sep
[
text
"let"
<+>
ppBinding
b
<+>
text
"in"
,
ppExpr
0
e
]
ppExpr
p
(
Letrec
bs
e
)
=
p
pP
aren
(
p
>
0
)
$
sep
ppExpr
p
(
Letrec
bs
e
)
=
paren
If
(
p
>
0
)
$
sep
[
text
"letrec"
<+>
vcat
(
map
ppBinding
bs
)
<+>
text
"in"
,
ppExpr
0
e
]
ppExpr
p
(
Typed
e
ty
)
=
p
pP
aren
(
p
>
0
)
$
sep
ppExpr
p
(
Typed
e
ty
)
=
paren
If
(
p
>
0
)
$
sep
[
ppExpr
0
e
,
text
"::"
,
ppType
0
ty
]
ppInfixApp
::
Int
->
Expression
->
QualIdent
->
Expression
->
Doc
ppInfixApp
p
e1
op
e2
=
p
pP
aren
(
p
>
1
)
$
sep
ppInfixApp
p
e1
op
e2
=
paren
If
(
p
>
1
)
$
sep
[
ppExpr
2
e1
<+>
ppQInfixOp
op
,
nest
exprIndent
(
ppExpr
2
e2
)]
ppIdent
::
Ident
->
Doc
...
...
@@ -170,6 +171,3 @@ typeVars :: [String]
typeVars
=
[
mkTypeVar
c
i
|
i
<-
[
0
..
],
c
<-
[
'a'
..
'z'
]]
where
mkTypeVar
::
Char
->
Int
->
String
mkTypeVar
c
i
=
c
:
if
i
==
0
then
[]
else
show
i
ppParen
::
Bool
->
Doc
->
Doc
ppParen
p
=
if
p
then
parens
else
id
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment