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
dac70ef7
Commit
dac70ef7
authored
Apr 08, 2016
by
Jan Rasmus Tikovsky
Browse files
Fixed linking for identifiers in Curry HTML documentation
parent
f351a076
Changes
2
Hide whitespace changes
Inline
Side-by-side
src/Html/CurryHtml.hs
View file @
dac70ef7
{- |
{- |
Module : $Header$
Module : $Header$
Description : Generating HTML documentation
Description : Generating HTML documentation
Copyright : (c) 2011 - 2015, Björn Peemöller
Copyright : (c) 2011 - 2016, Björn Peemöller
2016 , Jan Tikovsky
License : OtherLicense
License : OtherLicense
Maintainer : bjp@informatik.uni-kiel.de
Maintainer : bjp@informatik.uni-kiel.de
...
@@ -73,7 +74,7 @@ docModule opts f = do
...
@@ -73,7 +74,7 @@ docModule opts f = do
Just
src
->
do
Just
src
->
do
toks
<-
liftCYM
$
lexSource
f
src
toks
<-
liftCYM
$
lexSource
f
src
typed
@
(
Module
_
m
_
_
_
)
<-
fullParse
opts
f
src
typed
@
(
Module
_
m
_
_
_
)
<-
fullParse
opts
f
src
return
(
m
,
program2html
m
$
genProgram
f
typed
toks
)
return
(
m
,
program2html
m
$
genProgram
typed
toks
)
-- |Return the syntax tree of the source program 'src' (type 'Module'; see
-- |Return the syntax tree of the source program 'src' (type 'Module'; see
-- Module "CurrySyntax").after inferring the types of identifiers.
-- Module "CurrySyntax").after inferring the types of identifiers.
...
@@ -147,20 +148,20 @@ spanTag clV idV str
...
@@ -147,20 +148,20 @@ spanTag clV idV str
-- @param code
-- @param code
-- @return css class of the code
-- @return css class of the code
code2class
::
Code
->
String
code2class
::
Code
->
String
code2class
(
Space
_
)
=
""
code2class
(
Space
_
)
=
""
code2class
NewLine
=
""
code2class
NewLine
=
""
code2class
(
Keyword
_
)
=
"keyword"
code2class
(
Keyword
_
)
=
"keyword"
code2class
(
Pragma
_
)
=
"pragma"
code2class
(
Pragma
_
)
=
"pragma"
code2class
(
Symbol
_
)
=
"symbol"
code2class
(
Symbol
_
)
=
"symbol"
code2class
(
TypeCons
_
_
)
=
"type"
code2class
(
TypeCons
_
_
_
)
=
"type"
code2class
(
DataCons
_
_
)
=
"cons"
code2class
(
DataCons
_
_
_
)
=
"cons"
code2class
(
Function
_
_
)
=
"func"
code2class
(
Function
_
_
_
)
=
"func"
code2class
(
Identifier
_
_
)
=
"ident"
code2class
(
Identifier
_
_
_
)
=
"ident"
code2class
(
ModuleName
_
)
=
"module"
code2class
(
ModuleName
_
)
=
"module"
code2class
(
Commentary
_
)
=
"comment"
code2class
(
Commentary
_
)
=
"comment"
code2class
(
NumberCode
_
)
=
"number"
code2class
(
NumberCode
_
)
=
"number"
code2class
(
StringCode
_
)
=
"string"
code2class
(
StringCode
_
)
=
"string"
code2class
(
CharCode
_
)
=
"char"
code2class
(
CharCode
_
)
=
"char"
addModuleLink
::
ModuleIdent
->
ModuleIdent
->
String
->
String
addModuleLink
::
ModuleIdent
->
ModuleIdent
->
String
->
String
addModuleLink
m
m'
str
addModuleLink
m
m'
str
...
@@ -182,18 +183,18 @@ htmlFile :: ModuleIdent -> String
...
@@ -182,18 +183,18 @@ htmlFile :: ModuleIdent -> String
htmlFile
m
=
moduleName
m
++
"_curry.html"
htmlFile
m
=
moduleName
m
++
"_curry.html"
isCall
::
Code
->
Bool
isCall
::
Code
->
Bool
isCall
(
TypeCons
TypeExport
_
)
=
True
isCall
(
TypeCons
TypeExport
_
_
)
=
True
isCall
(
TypeCons
TypeImport
_
)
=
True
isCall
(
TypeCons
TypeImport
_
_
)
=
True
isCall
(
TypeCons
TypeRefer
_
)
=
True
isCall
(
TypeCons
TypeRefer
_
_
)
=
True
isCall
(
TypeCons
_
_
)
=
False
isCall
(
TypeCons
_
_
_
)
=
False
isCall
(
Identifier
_
_
)
=
False
isCall
(
Identifier
_
_
_
)
=
False
isCall
c
=
not
(
isDecl
c
)
&&
isJust
(
getQualIdent
c
)
isCall
c
=
not
(
isDecl
c
)
&&
isJust
(
getQualIdent
c
)
isDecl
::
Code
->
Bool
isDecl
::
Code
->
Bool
isDecl
(
DataCons
ConsDeclare
_
)
=
True
isDecl
(
DataCons
ConsDeclare
_
_
)
=
True
isDecl
(
Function
FuncDeclare
_
)
=
True
isDecl
(
Function
FuncDeclare
_
_
)
=
True
isDecl
(
TypeCons
TypeDeclare
_
)
=
True
isDecl
(
TypeCons
TypeDeclare
_
_
)
=
True
isDecl
_
=
False
isDecl
_
=
False
-- Translates arbitrary strings into equivalent urlencoded string.
-- Translates arbitrary strings into equivalent urlencoded string.
string2urlencoded
::
String
->
String
string2urlencoded
::
String
->
String
...
...
src/Html/SyntaxColoring.hs
View file @
dac70ef7
{- |
{- |
Module : $Header$
Module : $Header$
Description : Split module into code fragments
Description : Split module into code fragments
Copyright : (c) ?? , someone else
Copyright : (c) ?? , someone else
2014, Björn Peemöller
2014 - 2016, Björn Peemöller
2016 , Jan Tikovsky
License : OtherLicense
License : OtherLicense
Maintainer : bjp@informatik.uni-kiel.de
Maintainer : bjp@informatik.uni-kiel.de
...
@@ -10,8 +11,22 @@
...
@@ -10,8 +11,22 @@
Portability : portable
Portability : portable
This module arranges the tokens of the module into different code
This module arranges the tokens of the module into different code
categories for HTML presentation. The parsed and
typecheck
ed module
categories for HTML presentation. The parsed and
qualifi
ed module
is used to establish links between used identifiers and their definitions.
is used to establish links between used identifiers and their definitions.
The fully qualified module is traversed to generate a list of code elements.
Code elements representing identifiers are distinguished by their kind
(type constructor, data constructor, function, (type) variable).
They include information about their usage (i.e., declaration, call etc.)
and whether the identifier occurs fully qualified in
the source code or not. Initially, all identifier codes are fully qualified.
In a next step, the token stream of the given program and the code list are
traversed sequentially (see `encodeToks`). The information in the token
stream is used to:
* add code elements for newlines, spaces and pragmas
* update the qualification information of identifiers in the code list.
-}
-}
module
Html.SyntaxColoring
module
Html.SyntaxColoring
...
@@ -30,15 +45,17 @@ import Curry.Syntax
...
@@ -30,15 +45,17 @@ import Curry.Syntax
import
Base.Messages
import
Base.Messages
-- |Type of codes which are distinguished for HTML output
-- |Type of codes which are distinguished for HTML output
-- the boolean flags indicate whether the corresponding identifier
-- occurs qualified in the source module
data
Code
data
Code
=
Keyword
String
=
Keyword
String
|
Space
Int
|
Space
Int
|
NewLine
|
NewLine
|
Pragma
String
|
Pragma
String
|
TypeCons
TypeUsage
QualIdent
|
TypeCons
TypeUsage
Bool
QualIdent
|
DataCons
ConsUsage
QualIdent
|
DataCons
ConsUsage
Bool
QualIdent
|
Function
FuncUsage
QualIdent
|
Function
FuncUsage
Bool
QualIdent
|
Identifier
IdentUsage
QualIdent
|
Identifier
IdentUsage
Bool
QualIdent
|
ModuleName
ModuleIdent
|
ModuleName
ModuleIdent
|
Commentary
String
|
Commentary
String
|
NumberCode
String
|
NumberCode
String
...
@@ -78,21 +95,28 @@ data IdentUsage
...
@@ -78,21 +95,28 @@ data IdentUsage
|
IdUnknown
-- unknown usage
|
IdUnknown
-- unknown usage
deriving
Show
deriving
Show
-- @param list with parse-Results with descending quality,
-- @param fully qualified module
-- e.g. [typingParse, fullParse, parse]
-- @param lex-Result
-- @param lex-Result
-- @return program
-- @return code list
genProgram
::
String
->
Module
->
[(
Position
,
Token
)]
->
[
Code
]
genProgram
::
Module
->
[(
Position
,
Token
)]
->
[
Code
]
genProgram
fn
m
toks
=
encodeToks
(
first
fn
)
(
idsModule
m
)
toks
genProgram
m
pts
=
encodeToks
(
first
""
)
(
filter
validCode
(
idsModule
m
))
pts
-- predicate to remove identifier codes for primitives
-- because they do not form valid link targets
validCode
::
Code
->
Bool
validCode
(
TypeCons
_
_
t
)
=
t
`
notElem
`
[
qUnitId
,
qListId
]
&&
not
(
isQTupleId
t
)
validCode
(
DataCons
_
_
c
)
=
c
`
notElem
`
[
qUnitId
,
qNilId
,
qConsId
]
&&
not
(
isQTupleId
c
)
validCode
(
Identifier
_
_
i
)
=
not
$
isAnonId
$
unqualify
i
validCode
_
=
True
-- @param code
-- @param code
-- @return qid if available
-- @return qid if available
getQualIdent
::
Code
->
Maybe
QualIdent
getQualIdent
::
Code
->
Maybe
QualIdent
getQualIdent
(
DataCons
_
qid
)
=
Just
qid
getQualIdent
(
DataCons
_
_
qid
)
=
Just
qid
getQualIdent
(
Function
_
qid
)
=
Just
qid
getQualIdent
(
Function
_
_
qid
)
=
Just
qid
getQualIdent
(
Identifier
_
qid
)
=
Just
qid
getQualIdent
(
Identifier
_
_
qid
)
=
Just
qid
getQualIdent
(
TypeCons
_
qid
)
=
Just
qid
getQualIdent
(
TypeCons
_
_
qid
)
=
Just
qid
getQualIdent
_
=
Nothing
getQualIdent
_
=
Nothing
encodeToks
::
Position
->
[
Code
]
->
[(
Position
,
Token
)]
->
[
Code
]
encodeToks
::
Position
->
[
Code
]
->
[(
Position
,
Token
)]
->
[
Code
]
encodeToks
_
_
[]
=
[]
encodeToks
_
_
[]
=
[]
...
@@ -108,30 +132,47 @@ encodeToks cur ids toks@((pos, tok) : ts)
...
@@ -108,30 +132,47 @@ encodeToks cur ids toks@((pos, tok) : ts)
in
Pragma
s
:
encodeToks
(
incr
cur
(
length
s
))
ids
rest
in
Pragma
s
:
encodeToks
(
incr
cur
(
length
s
))
ids
rest
-- identifier token
-- identifier token
|
isIdentTok
tok
=
case
ids
of
|
isIdentTok
tok
=
case
ids
of
[]
->
encodeTok
tok
:
encodeToks
newPos
[]
ts
[]
->
encodeTok
tok
:
encodeToks
newPos
[]
ts
(
i
:
is
)
|
tokenStr
==
code2string
i
->
i
:
encodeToks
newPos
is
ts
(
i
:
is
)
|
otherwise
->
encodeToks
cur
is
toks
|
tokenStr
==
code2string
i'
->
i'
:
encodeToks
newPos
is
ts
-- the 'otherwise' case should never occur if the token stream and
-- the qualified AST which was used to generate the code list correspond to
-- the same module
|
otherwise
->
encodeToks
cur
is
toks
where
i'
=
setQualified
(
isQualIdentTok
tok
)
i
-- other token
-- other token
|
otherwise
=
encodeTok
tok
:
encodeToks
newPos
ids
ts
|
otherwise
=
encodeTok
tok
:
encodeToks
newPos
ids
ts
where
where
tokenStr
=
showToken
tok
tokenStr
=
showToken
tok
newPos
=
incr
cur
(
length
tokenStr
)
newPos
=
incr
cur
(
length
tokenStr
)
setQualified
::
Bool
->
Code
->
Code
setQualified
b
(
DataCons
u
_
c
)
=
DataCons
u
b
c
setQualified
b
(
Function
u
_
f
)
=
Function
u
b
f
setQualified
b
(
Identifier
u
_
i
)
=
Identifier
u
b
i
setQualified
b
(
TypeCons
u
_
t
)
=
TypeCons
u
b
t
setQualified
_
m
@
(
ModuleName
_
)
=
m
setQualified
_
c
=
internalError
$
"Html.SyntaxColoring.setQualified: "
++
show
c
code2string
::
Code
->
String
code2string
::
Code
->
String
code2string
(
Keyword
s
)
=
s
code2string
(
Keyword
s
)
=
s
code2string
(
Space
i
)
=
replicate
i
' '
code2string
(
Space
i
)
=
replicate
i
' '
code2string
NewLine
=
"
\n
"
code2string
NewLine
=
"
\n
"
code2string
(
Pragma
s
)
=
s
code2string
(
Pragma
s
)
=
s
code2string
(
DataCons
_
qid
)
=
qualName
qid
code2string
(
DataCons
_
b
qid
)
=
ident2string
b
qid
code2string
(
TypeCons
_
qid
)
=
qualName
qid
code2string
(
TypeCons
_
b
qid
)
=
ident2string
b
qid
code2string
(
Function
_
qid
)
=
qualName
qid
code2string
(
Function
_
b
qid
)
=
ident2string
b
qid
code2string
(
Identifier
_
qid
)
=
qualName
qid
code2string
(
Identifier
_
b
qid
)
=
ident2string
b
qid
code2string
(
ModuleName
mid
)
=
moduleName
mid
code2string
(
ModuleName
mid
)
=
moduleName
mid
code2string
(
Commentary
s
)
=
s
code2string
(
Commentary
s
)
=
s
code2string
(
NumberCode
s
)
=
s
code2string
(
NumberCode
s
)
=
s
code2string
(
StringCode
s
)
=
s
code2string
(
StringCode
s
)
=
s
code2string
(
CharCode
s
)
=
s
code2string
(
CharCode
s
)
=
s
code2string
(
Symbol
s
)
=
s
code2string
(
Symbol
s
)
=
s
ident2string
::
Bool
->
QualIdent
->
String
ident2string
False
q
=
idName
$
unqualify
q
ident2string
True
q
=
qualName
q
encodeTok
::
Token
->
Code
encodeTok
::
Token
->
Code
encodeTok
tok
@
(
Token
c
_
)
encodeTok
tok
@
(
Token
c
_
)
...
@@ -143,7 +184,7 @@ encodeTok tok@(Token c _)
...
@@ -143,7 +184,7 @@ encodeTok tok@(Token c _)
|
c
`
elem
`
punctuationCategories
=
Symbol
(
showToken
tok
)
|
c
`
elem
`
punctuationCategories
=
Symbol
(
showToken
tok
)
|
c
`
elem
`
reservedOpsCategories
=
Symbol
(
showToken
tok
)
|
c
`
elem
`
reservedOpsCategories
=
Symbol
(
showToken
tok
)
|
c
`
elem
`
commentCategories
=
Commentary
(
showToken
tok
)
|
c
`
elem
`
commentCategories
=
Commentary
(
showToken
tok
)
|
c
`
elem
`
identCategories
=
Identifier
IdUnknown
$
qualify
$
mkIdent
|
c
`
elem
`
identCategories
=
Identifier
IdUnknown
False
$
qualify
$
mkIdent
$
showToken
tok
$
showToken
tok
|
c
`
elem
`
whiteSpaceCategories
=
Space
0
|
c
`
elem
`
whiteSpaceCategories
=
Space
0
|
c
`
elem
`
pragmaCategories
=
Pragma
(
showToken
tok
)
|
c
`
elem
`
pragmaCategories
=
Pragma
(
showToken
tok
)
...
@@ -190,6 +231,9 @@ isPragmaEnd (Token c _) = c == PragmaEnd
...
@@ -190,6 +231,9 @@ isPragmaEnd (Token c _) = c == PragmaEnd
isIdentTok
::
Token
->
Bool
isIdentTok
::
Token
->
Bool
isIdentTok
(
Token
c
_
)
=
c
`
elem
`
identCategories
isIdentTok
(
Token
c
_
)
=
c
`
elem
`
identCategories
isQualIdentTok
::
Token
->
Bool
isQualIdentTok
(
Token
c
_
)
=
c
`
elem
`
[
QId
,
QSym
]
whiteSpaceCategories
::
[
Category
]
whiteSpaceCategories
::
[
Category
]
whiteSpaceCategories
=
[
EOF
,
VSemicolon
,
VRightBrace
]
whiteSpaceCategories
=
[
EOF
,
VSemicolon
,
VRightBrace
]
...
@@ -237,10 +281,10 @@ idsExportSpec Nothing = []
...
@@ -237,10 +281,10 @@ idsExportSpec Nothing = []
idsExportSpec
(
Just
(
Exporting
_
es
))
=
concatMap
idsExport
es
idsExportSpec
(
Just
(
Exporting
_
es
))
=
concatMap
idsExport
es
idsExport
::
Export
->
[
Code
]
idsExport
::
Export
->
[
Code
]
idsExport
(
Export
qid
)
=
[
Function
FuncExport
qid
]
idsExport
(
Export
qid
)
=
[
Function
FuncExport
False
qid
]
idsExport
(
ExportTypeWith
qid
cs
)
=
TypeCons
TypeExport
qid
:
idsExport
(
ExportTypeWith
qid
cs
)
=
TypeCons
TypeExport
False
qid
:
map
(
DataCons
ConsExport
.
qualify
)
cs
map
(
DataCons
ConsExport
False
.
qualify
)
cs
idsExport
(
ExportTypeAll
qid
)
=
[
TypeCons
TypeExport
qid
]
idsExport
(
ExportTypeAll
qid
)
=
[
TypeCons
TypeExport
False
qid
]
idsExport
(
ExportModule
mid
)
=
[
ModuleName
mid
]
idsExport
(
ExportModule
mid
)
=
[
ModuleName
mid
]
-- Imports
-- Imports
...
@@ -256,53 +300,53 @@ idsImportSpec mid (Hiding _ is) = concatMap (idsImport mid) is
...
@@ -256,53 +300,53 @@ idsImportSpec mid (Hiding _ is) = concatMap (idsImport mid) is
idsImport
::
ModuleIdent
->
Import
->
[
Code
]
idsImport
::
ModuleIdent
->
Import
->
[
Code
]
idsImport
mid
(
Import
i
)
=
idsImport
mid
(
Import
i
)
=
[
Function
FuncImport
$
qualifyWith
mid
i
]
[
Function
FuncImport
False
$
qualifyWith
mid
i
]
idsImport
mid
(
ImportTypeWith
t
cs
)
=
idsImport
mid
(
ImportTypeWith
t
cs
)
=
TypeCons
TypeImport
(
qualifyWith
mid
t
)
:
TypeCons
TypeImport
False
(
qualifyWith
mid
t
)
:
map
(
DataCons
ConsImport
.
qualifyWith
mid
)
cs
map
(
DataCons
ConsImport
False
.
qualifyWith
mid
)
cs
idsImport
mid
(
ImportTypeAll
t
)
=
idsImport
mid
(
ImportTypeAll
t
)
=
[
TypeCons
TypeImport
$
qualifyWith
mid
t
]
[
TypeCons
TypeImport
False
$
qualifyWith
mid
t
]
-- Declarations
-- Declarations
idsDecl
::
Decl
->
[
Code
]
idsDecl
::
Decl
->
[
Code
]
idsDecl
(
InfixDecl
_
_
_
ops
)
=
map
(
Function
FuncInfix
.
qualify
)
ops
idsDecl
(
InfixDecl
_
_
_
ops
)
=
map
(
Function
FuncInfix
False
.
qualify
)
ops
idsDecl
(
DataDecl
_
d
vs
cds
)
=
TypeCons
TypeDeclare
(
qualify
d
)
idsDecl
(
DataDecl
_
d
vs
cds
)
=
TypeCons
TypeDeclare
False
(
qualify
d
)
:
map
(
Identifier
IdDeclare
.
qualify
)
vs
:
map
(
Identifier
IdDeclare
False
.
qualify
)
vs
++
concatMap
idsConstrDecl
cds
++
concatMap
idsConstrDecl
cds
idsDecl
(
NewtypeDecl
_
t
vs
nc
)
=
TypeCons
TypeDeclare
(
qualify
t
)
idsDecl
(
NewtypeDecl
_
t
vs
nc
)
=
TypeCons
TypeDeclare
False
(
qualify
t
)
:
map
(
Identifier
IdDeclare
.
qualify
)
vs
:
map
(
Identifier
IdDeclare
False
.
qualify
)
vs
++
idsNewConstrDecl
nc
++
idsNewConstrDecl
nc
idsDecl
(
TypeDecl
_
t
vs
ty
)
=
TypeCons
TypeDeclare
(
qualify
t
)
idsDecl
(
TypeDecl
_
t
vs
ty
)
=
TypeCons
TypeDeclare
False
(
qualify
t
)
:
map
(
Identifier
IdDeclare
.
qualify
)
vs
:
map
(
Identifier
IdDeclare
False
.
qualify
)
vs
++
idsTypeExpr
ty
++
idsTypeExpr
ty
idsDecl
(
TypeSig
_
fs
ty
)
=
map
(
Function
FuncTypeSig
.
qualify
)
fs
idsDecl
(
TypeSig
_
fs
ty
)
=
map
(
Function
FuncTypeSig
False
.
qualify
)
fs
++
idsTypeExpr
ty
++
idsTypeExpr
ty
idsDecl
(
FunctionDecl
_
_
eqs
)
=
concatMap
idsEquation
eqs
idsDecl
(
FunctionDecl
_
_
eqs
)
=
concatMap
idsEquation
eqs
idsDecl
(
ForeignDecl
_
_
_
_
_
)
=
[]
idsDecl
(
ForeignDecl
_
_
_
_
_
)
=
[]
idsDecl
(
ExternalDecl
_
fs
)
=
map
(
Function
FuncDeclare
.
qualify
)
fs
idsDecl
(
ExternalDecl
_
fs
)
=
map
(
Function
FuncDeclare
False
.
qualify
)
fs
idsDecl
(
PatternDecl
_
p
rhs
)
=
idsPat
p
++
idsRhs
rhs
idsDecl
(
PatternDecl
_
p
rhs
)
=
idsPat
p
++
idsRhs
rhs
idsDecl
(
FreeDecl
_
vs
)
=
map
(
Identifier
IdDeclare
.
qualify
)
vs
idsDecl
(
FreeDecl
_
vs
)
=
map
(
Identifier
IdDeclare
False
.
qualify
)
vs
idsConstrDecl
::
ConstrDecl
->
[
Code
]
idsConstrDecl
::
ConstrDecl
->
[
Code
]
idsConstrDecl
(
ConstrDecl
_
_
c
tys
)
idsConstrDecl
(
ConstrDecl
_
_
c
tys
)
=
DataCons
ConsDeclare
(
qualify
c
)
:
concatMap
idsTypeExpr
tys
=
DataCons
ConsDeclare
False
(
qualify
c
)
:
concatMap
idsTypeExpr
tys
idsConstrDecl
(
ConOpDecl
_
_
ty1
op
ty2
)
idsConstrDecl
(
ConOpDecl
_
_
ty1
op
ty2
)
=
idsTypeExpr
ty1
++
(
DataCons
ConsDeclare
$
qualify
op
)
:
idsTypeExpr
ty2
=
idsTypeExpr
ty1
++
(
DataCons
ConsDeclare
False
$
qualify
op
)
:
idsTypeExpr
ty2
idsConstrDecl
(
RecordDecl
_
_
c
fs
)
idsConstrDecl
(
RecordDecl
_
_
c
fs
)
=
DataCons
ConsDeclare
(
qualify
c
)
:
concatMap
idsFieldDecl
fs
=
DataCons
ConsDeclare
False
(
qualify
c
)
:
concatMap
idsFieldDecl
fs
idsNewConstrDecl
::
NewConstrDecl
->
[
Code
]
idsNewConstrDecl
::
NewConstrDecl
->
[
Code
]
idsNewConstrDecl
(
NewConstrDecl
_
_
c
ty
)
idsNewConstrDecl
(
NewConstrDecl
_
_
c
ty
)
=
DataCons
ConsDeclare
(
qualify
c
)
:
idsTypeExpr
ty
=
DataCons
ConsDeclare
False
(
qualify
c
)
:
idsTypeExpr
ty
idsNewConstrDecl
(
NewRecordDecl
_
_
c
(
l
,
ty
))
idsNewConstrDecl
(
NewRecordDecl
_
_
c
(
l
,
ty
))
=
DataCons
ConsDeclare
(
qualify
c
)
:
(
Function
FuncDeclare
$
qualify
l
)
=
DataCons
ConsDeclare
False
(
qualify
c
)
:
(
Function
FuncDeclare
False
$
qualify
l
)
:
idsTypeExpr
ty
:
idsTypeExpr
ty
idsTypeExpr
::
TypeExpr
->
[
Code
]
idsTypeExpr
::
TypeExpr
->
[
Code
]
idsTypeExpr
(
ConstructorType
qid
tys
)
=
TypeCons
TypeRefer
qid
:
idsTypeExpr
(
ConstructorType
qid
tys
)
=
TypeCons
TypeRefer
False
qid
:
concatMap
idsTypeExpr
tys
concatMap
idsTypeExpr
tys
idsTypeExpr
(
VariableType
v
)
=
[
Identifier
IdRefer
(
qualify
v
)]
idsTypeExpr
(
VariableType
v
)
=
[
Identifier
IdRefer
False
(
qualify
v
)]
idsTypeExpr
(
TupleType
tys
)
=
concatMap
idsTypeExpr
tys
idsTypeExpr
(
TupleType
tys
)
=
concatMap
idsTypeExpr
tys
idsTypeExpr
(
ListType
ty
)
=
idsTypeExpr
ty
idsTypeExpr
(
ListType
ty
)
=
idsTypeExpr
ty
idsTypeExpr
(
ArrowType
ty1
ty2
)
=
concatMap
idsTypeExpr
[
ty1
,
ty2
]
idsTypeExpr
(
ArrowType
ty1
ty2
)
=
concatMap
idsTypeExpr
[
ty1
,
ty2
]
...
@@ -310,14 +354,14 @@ idsTypeExpr (ParenType ty) = idsTypeExpr ty
...
@@ -310,14 +354,14 @@ idsTypeExpr (ParenType ty) = idsTypeExpr ty
idsFieldDecl
::
FieldDecl
->
[
Code
]
idsFieldDecl
::
FieldDecl
->
[
Code
]
idsFieldDecl
(
FieldDecl
_
ls
ty
)
=
idsFieldDecl
(
FieldDecl
_
ls
ty
)
=
map
(
Function
FuncDeclare
.
qualify
.
unRenameIdent
)
ls
++
idsTypeExpr
ty
map
(
Function
FuncDeclare
False
.
qualify
.
unRenameIdent
)
ls
++
idsTypeExpr
ty
idsEquation
::
Equation
->
[
Code
]
idsEquation
::
Equation
->
[
Code
]
idsEquation
(
Equation
_
lhs
rhs
)
=
idsLhs
lhs
++
idsRhs
rhs
idsEquation
(
Equation
_
lhs
rhs
)
=
idsLhs
lhs
++
idsRhs
rhs
idsLhs
::
Lhs
->
[
Code
]
idsLhs
::
Lhs
->
[
Code
]
idsLhs
(
FunLhs
f
ps
)
=
Function
FuncDeclare
(
qualify
f
)
:
concatMap
idsPat
ps
idsLhs
(
FunLhs
f
ps
)
=
Function
FuncDeclare
False
(
qualify
f
)
:
concatMap
idsPat
ps
idsLhs
(
OpLhs
p1
op
p2
)
=
idsPat
p1
++
[
Function
FuncDeclare
$
qualify
op
]
idsLhs
(
OpLhs
p1
op
p2
)
=
idsPat
p1
++
[
Function
FuncDeclare
False
$
qualify
op
]
++
idsPat
p2
++
idsPat
p2
idsLhs
(
ApLhs
lhs
ps
)
=
idsLhs
lhs
++
concatMap
idsPat
ps
idsLhs
(
ApLhs
lhs
ps
)
=
idsLhs
lhs
++
concatMap
idsPat
ps
...
@@ -331,33 +375,33 @@ idsCondExpr (CondExpr _ e1 e2) = idsExpr e1 ++ idsExpr e2
...
@@ -331,33 +375,33 @@ idsCondExpr (CondExpr _ e1 e2) = idsExpr e1 ++ idsExpr e2
idsPat
::
Pattern
->
[
Code
]
idsPat
::
Pattern
->
[
Code
]
idsPat
(
LiteralPattern
_
)
=
[]
idsPat
(
LiteralPattern
_
)
=
[]
idsPat
(
NegativePattern
_
_
)
=
[]
idsPat
(
NegativePattern
_
_
)
=
[]
idsPat
(
VariablePattern
v
)
=
[
Identifier
IdDeclare
(
qualify
v
)]
idsPat
(
VariablePattern
v
)
=
[
Identifier
IdDeclare
False
(
qualify
v
)]
idsPat
(
ConstructorPattern
qid
ps
)
=
DataCons
ConsPattern
qid
idsPat
(
ConstructorPattern
qid
ps
)
=
DataCons
ConsPattern
False
qid
:
concatMap
idsPat
ps
:
concatMap
idsPat
ps
idsPat
(
InfixPattern
p1
qid
p2
)
=
idsPat
p1
++
idsPat
(
InfixPattern
p1
qid
p2
)
=
idsPat
p1
++
DataCons
ConsPattern
qid
:
idsPat
p2
DataCons
ConsPattern
False
qid
:
idsPat
p2
idsPat
(
ParenPattern
p
)
=
idsPat
p
idsPat
(
ParenPattern
p
)
=
idsPat
p
idsPat
(
RecordPattern
qid
fs
)
=
DataCons
ConsPattern
qid
idsPat
(
RecordPattern
qid
fs
)
=
DataCons
ConsPattern
False
qid
:
concatMap
(
idsField
idsPat
)
fs
:
concatMap
(
idsField
idsPat
)
fs
idsPat
(
TuplePattern
_
ps
)
=
concatMap
idsPat
ps
idsPat
(
TuplePattern
_
ps
)
=
concatMap
idsPat
ps
idsPat
(
ListPattern
_
ps
)
=
concatMap
idsPat
ps
idsPat
(
ListPattern
_
ps
)
=
concatMap
idsPat
ps
idsPat
(
AsPattern
v
p
)
=
Identifier
IdDeclare
(
qualify
v
)
:
idsPat
p
idsPat
(
AsPattern
v
p
)
=
Identifier
IdDeclare
False
(
qualify
v
)
:
idsPat
p
idsPat
(
LazyPattern
_
p
)
=
idsPat
p
idsPat
(
LazyPattern
_
p
)
=
idsPat
p
idsPat
(
FunctionPattern
qid
ps
)
=
Function
FuncCall
qid
idsPat
(
FunctionPattern
qid
ps
)
=
Function
FuncCall
False
qid
:
concatMap
idsPat
ps
:
concatMap
idsPat
ps
idsPat
(
InfixFuncPattern
p1
f
p2
)
=
idsPat
p1
++
idsPat
(
InfixFuncPattern
p1
f
p2
)
=
idsPat
p1
++
Function
FuncInfix
f
:
idsPat
p2
Function
FuncInfix
False
f
:
idsPat
p2
idsExpr
::
Expression
->
[
Code
]
idsExpr
::
Expression
->
[
Code
]
idsExpr
(
Literal
_
)
=
[]
idsExpr
(
Literal
_
)
=
[]
idsExpr
(
Variable
qid
)
idsExpr
(
Variable
qid
)
|
isQualified
qid
=
[
Function
FuncCall
qid
]
|
isQualified
qid
=
[
Function
FuncCall
False
qid
]
|
hasGlobalScope
(
unqualify
qid
)
=
[
Function
FuncCall
qid
]
|
hasGlobalScope
(
unqualify
qid
)
=
[
Function
FuncCall
False
qid
]
|
otherwise
=
[
Identifier
IdRefer
qid
]
|
otherwise
=
[
Identifier
IdRefer
False
qid
]
idsExpr
(
Constructor
qid
)
=
[
DataCons
ConsCall
qid
]
idsExpr
(
Constructor
qid
)
=
[
DataCons
ConsCall
False
qid
]
idsExpr
(
Paren
e
)
=
idsExpr
e
idsExpr
(
Paren
e
)
=
idsExpr
e
idsExpr
(
Typed
e
ty
)
=
idsExpr
e
++
idsTypeExpr
ty
idsExpr
(
Typed
e
ty
)
=
idsExpr
e
++
idsTypeExpr
ty
idsExpr
(
Record
qid
fs
)
=
DataCons
ConsCall
qid
idsExpr
(
Record
qid
fs
)
=
DataCons
ConsCall
False
qid
:
concatMap
(
idsField
idsExpr
)
fs
:
concatMap
(
idsField
idsExpr
)
fs
idsExpr
(
RecordUpdate
e
fs
)
=
idsExpr
e
idsExpr
(
RecordUpdate
e
fs
)
=
idsExpr
e
++
concatMap
(
idsField
idsExpr
)
fs
++
concatMap
(
idsField
idsExpr
)
fs
...
@@ -380,11 +424,11 @@ idsExpr (IfThenElse _ e1 e2 e3) = concatMap idsExpr [e1, e2, e3]
...
@@ -380,11 +424,11 @@ idsExpr (IfThenElse _ e1 e2 e3) = concatMap idsExpr [e1, e2, e3]
idsExpr
(
Case
_
_
e
alts
)
=
idsExpr
e
++
concatMap
idsAlt
alts
idsExpr
(
Case
_
_
e
alts
)
=
idsExpr
e
++
concatMap
idsAlt
alts
idsField
::
(
a
->
[
Code
])
->
Field
a
->
[
Code
]
idsField
::
(
a
->
[
Code
])
->
Field
a
->
[
Code
]
idsField
f
(
Field
_
l
x
)
=
Function
FuncCall
l
:
f
x
idsField
f
(
Field
_
l
x
)
=
Function
FuncCall
False
l
:
f
x
idsInfix
::
InfixOp
->
[
Code
]
idsInfix
::
InfixOp
->
[
Code
]
idsInfix
(
InfixOp
qid
)
=
[
Function
FuncInfix
qid
]
idsInfix
(
InfixOp
qid
)
=
[
Function
FuncInfix
False
qid
]
idsInfix
(
InfixConstr
qid
)
=
[
DataCons
ConsInfix
qid
]
idsInfix
(
InfixConstr
qid
)
=
[
DataCons
ConsInfix
False
qid
]
idsStmt
::
Statement
->
[
Code
]
idsStmt
::
Statement
->
[
Code
]
idsStmt
(
StmtExpr
_
e
)
=
idsExpr
e
idsStmt
(
StmtExpr
_
e
)
=
idsExpr
e
...
...
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