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$
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
Maintainer : bjp@informatik.uni-kiel.de
...
...
@@ -73,7 +74,7 @@ docModule opts f = do
Just
src
->
do
toks
<-
liftCYM
$
lexSource
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
-- Module "CurrySyntax").after inferring the types of identifiers.
...
...
@@ -147,20 +148,20 @@ spanTag clV idV str
-- @param code
-- @return css class of the code
code2class
::
Code
->
String
code2class
(
Space
_
)
=
""
code2class
NewLine
=
""
code2class
(
Keyword
_
)
=
"keyword"
code2class
(
Pragma
_
)
=
"pragma"
code2class
(
Symbol
_
)
=
"symbol"
code2class
(
TypeCons
_
_
)
=
"type"
code2class
(
DataCons
_
_
)
=
"cons"
code2class
(
Function
_
_
)
=
"func"
code2class
(
Identifier
_
_
)
=
"ident"
code2class
(
ModuleName
_
)
=
"module"
code2class
(
Commentary
_
)
=
"comment"
code2class
(
NumberCode
_
)
=
"number"
code2class
(
StringCode
_
)
=
"string"
code2class
(
CharCode
_
)
=
"char"
code2class
(
Space
_
)
=
""
code2class
NewLine
=
""
code2class
(
Keyword
_
)
=
"keyword"
code2class
(
Pragma
_
)
=
"pragma"
code2class
(
Symbol
_
)
=
"symbol"
code2class
(
TypeCons
_
_
_
)
=
"type"
code2class
(
DataCons
_
_
_
)
=
"cons"
code2class
(
Function
_
_
_
)
=
"func"
code2class
(
Identifier
_
_
_
)
=
"ident"
code2class
(
ModuleName
_
)
=
"module"
code2class
(
Commentary
_
)
=
"comment"
code2class
(
NumberCode
_
)
=
"number"
code2class
(
StringCode
_
)
=
"string"
code2class
(
CharCode
_
)
=
"char"
addModuleLink
::
ModuleIdent
->
ModuleIdent
->
String
->
String
addModuleLink
m
m'
str
...
...
@@ -182,18 +183,18 @@ htmlFile :: ModuleIdent -> String
htmlFile
m
=
moduleName
m
++
"_curry.html"
isCall
::
Code
->
Bool
isCall
(
TypeCons
TypeExport
_
)
=
True
isCall
(
TypeCons
TypeImport
_
)
=
True
isCall
(
TypeCons
TypeRefer
_
)
=
True
isCall
(
TypeCons
_
_
)
=
False
isCall
(
Identifier
_
_
)
=
False
isCall
(
TypeCons
TypeExport
_
_
)
=
True
isCall
(
TypeCons
TypeImport
_
_
)
=
True
isCall
(
TypeCons
TypeRefer
_
_
)
=
True
isCall
(
TypeCons
_
_
_
)
=
False
isCall
(
Identifier
_
_
_
)
=
False
isCall
c
=
not
(
isDecl
c
)
&&
isJust
(
getQualIdent
c
)
isDecl
::
Code
->
Bool
isDecl
(
DataCons
ConsDeclare
_
)
=
True
isDecl
(
Function
FuncDeclare
_
)
=
True
isDecl
(
TypeCons
TypeDeclare
_
)
=
True
isDecl
_
=
False
isDecl
(
DataCons
ConsDeclare
_
_
)
=
True
isDecl
(
Function
FuncDeclare
_
_
)
=
True
isDecl
(
TypeCons
TypeDeclare
_
_
)
=
True
isDecl
_
=
False
-- Translates arbitrary strings into equivalent urlencoded string.
string2urlencoded
::
String
->
String
...
...
src/Html/SyntaxColoring.hs
View file @
dac70ef7
{- |
Module : $Header$
Description : Split module into code fragments
Copyright : (c) ?? , someone else
2014, Björn Peemöller
Copyright : (c) ?? , someone else
2014 - 2016, Björn Peemöller
2016 , Jan Tikovsky
License : OtherLicense
Maintainer : bjp@informatik.uni-kiel.de
...
...
@@ -10,8 +11,22 @@
Portability : portable
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.
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
...
...
@@ -30,15 +45,17 @@ import Curry.Syntax
import
Base.Messages
-- |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
=
Keyword
String
|
Space
Int
|
NewLine
|
Pragma
String
|
TypeCons
TypeUsage
QualIdent
|
DataCons
ConsUsage
QualIdent
|
Function
FuncUsage
QualIdent
|
Identifier
IdentUsage
QualIdent
|
TypeCons
TypeUsage
Bool
QualIdent
|
DataCons
ConsUsage
Bool
QualIdent
|
Function
FuncUsage
Bool
QualIdent
|
Identifier
IdentUsage
Bool
QualIdent
|
ModuleName
ModuleIdent
|
Commentary
String
|
NumberCode
String
...
...
@@ -78,21 +95,28 @@ data IdentUsage
|
IdUnknown
-- unknown usage
deriving
Show
-- @param list with parse-Results with descending quality,
-- e.g. [typingParse, fullParse, parse]
-- @param fully qualified module
-- @param lex-Result
-- @return program
genProgram
::
String
->
Module
->
[(
Position
,
Token
)]
->
[
Code
]
genProgram
fn
m
toks
=
encodeToks
(
first
fn
)
(
idsModule
m
)
toks
-- @return code list
genProgram
::
Module
->
[(
Position
,
Token
)]
->
[
Code
]
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
-- @return qid if available
getQualIdent
::
Code
->
Maybe
QualIdent
getQualIdent
(
DataCons
_
qid
)
=
Just
qid
getQualIdent
(
Function
_
qid
)
=
Just
qid
getQualIdent
(
Identifier
_
qid
)
=
Just
qid
getQualIdent
(
TypeCons
_
qid
)
=
Just
qid
getQualIdent
_
=
Nothing
getQualIdent
(
DataCons
_
_
qid
)
=
Just
qid
getQualIdent
(
Function
_
_
qid
)
=
Just
qid
getQualIdent
(
Identifier
_
_
qid
)
=
Just
qid
getQualIdent
(
TypeCons
_
_
qid
)
=
Just
qid
getQualIdent
_
=
Nothing
encodeToks
::
Position
->
[
Code
]
->
[(
Position
,
Token
)]
->
[
Code
]
encodeToks
_
_
[]
=
[]
...
...
@@ -108,30 +132,47 @@ encodeToks cur ids toks@((pos, tok) : ts)
in
Pragma
s
:
encodeToks
(
incr
cur
(
length
s
))
ids
rest
-- identifier token
|
isIdentTok
tok
=
case
ids
of
[]
->
encodeTok
tok
:
encodeToks
newPos
[]
ts
(
i
:
is
)
|
tokenStr
==
code2string
i
->
i
:
encodeToks
newPos
is
ts
|
otherwise
->
encodeToks
cur
is
toks
[]
->
encodeTok
tok
:
encodeToks
newPos
[]
ts
(
i
:
is
)
|
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
|
otherwise
=
encodeTok
tok
:
encodeToks
newPos
ids
ts
where
tokenStr
=
showToken
tok
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
(
Keyword
s
)
=
s
code2string
(
Space
i
)
=
replicate
i
' '
code2string
NewLine
=
"
\n
"
code2string
(
Pragma
s
)
=
s
code2string
(
DataCons
_
qid
)
=
qualName
qid
code2string
(
TypeCons
_
qid
)
=
qualName
qid
code2string
(
Function
_
qid
)
=
qualName
qid
code2string
(
Identifier
_
qid
)
=
qualName
qid
code2string
(
ModuleName
mid
)
=
moduleName
mid
code2string
(
Commentary
s
)
=
s
code2string
(
NumberCode
s
)
=
s
code2string
(
StringCode
s
)
=
s
code2string
(
CharCode
s
)
=
s
code2string
(
Symbol
s
)
=
s
code2string
(
Keyword
s
)
=
s
code2string
(
Space
i
)
=
replicate
i
' '
code2string
NewLine
=
"
\n
"
code2string
(
Pragma
s
)
=
s
code2string
(
DataCons
_
b
qid
)
=
ident2string
b
qid
code2string
(
TypeCons
_
b
qid
)
=
ident2string
b
qid
code2string
(
Function
_
b
qid
)
=
ident2string
b
qid
code2string
(
Identifier
_
b
qid
)
=
ident2string
b
qid
code2string
(
ModuleName
mid
)
=
moduleName
mid
code2string
(
Commentary
s
)
=
s
code2string
(
NumberCode
s
)
=
s
code2string
(
StringCode
s
)
=
s
code2string
(
CharCode
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
tok
@
(
Token
c
_
)
...
...
@@ -143,7 +184,7 @@ encodeTok tok@(Token c _)
|
c
`
elem
`
punctuationCategories
=
Symbol
(
showToken
tok
)
|
c
`
elem
`
reservedOpsCategories
=
Symbol
(
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
|
c
`
elem
`
whiteSpaceCategories
=
Space
0
|
c
`
elem
`
pragmaCategories
=
Pragma
(
showToken
tok
)
...
...
@@ -190,6 +231,9 @@ isPragmaEnd (Token c _) = c == PragmaEnd
isIdentTok
::
Token
->
Bool
isIdentTok
(
Token
c
_
)
=
c
`
elem
`
identCategories
isQualIdentTok
::
Token
->
Bool
isQualIdentTok
(
Token
c
_
)
=
c
`
elem
`
[
QId
,
QSym
]
whiteSpaceCategories
::
[
Category
]
whiteSpaceCategories
=
[
EOF
,
VSemicolon
,
VRightBrace
]
...
...
@@ -237,10 +281,10 @@ idsExportSpec Nothing = []
idsExportSpec
(
Just
(
Exporting
_
es
))
=
concatMap
idsExport
es
idsExport
::
Export
->
[
Code
]
idsExport
(
Export
qid
)
=
[
Function
FuncExport
qid
]
idsExport
(
ExportTypeWith
qid
cs
)
=
TypeCons
TypeExport
qid
:
map
(
DataCons
ConsExport
.
qualify
)
cs
idsExport
(
ExportTypeAll
qid
)
=
[
TypeCons
TypeExport
qid
]
idsExport
(
Export
qid
)
=
[
Function
FuncExport
False
qid
]
idsExport
(
ExportTypeWith
qid
cs
)
=
TypeCons
TypeExport
False
qid
:
map
(
DataCons
ConsExport
False
.
qualify
)
cs
idsExport
(
ExportTypeAll
qid
)
=
[
TypeCons
TypeExport
False
qid
]
idsExport
(
ExportModule
mid
)
=
[
ModuleName
mid
]
-- Imports
...
...
@@ -256,53 +300,53 @@ idsImportSpec mid (Hiding _ is) = concatMap (idsImport mid) is
idsImport
::
ModuleIdent
->
Import
->
[
Code
]
idsImport
mid
(
Import
i
)
=
[
Function
FuncImport
$
qualifyWith
mid
i
]
[
Function
FuncImport
False
$
qualifyWith
mid
i
]
idsImport
mid
(
ImportTypeWith
t
cs
)
=
TypeCons
TypeImport
(
qualifyWith
mid
t
)
:
map
(
DataCons
ConsImport
.
qualifyWith
mid
)
cs
TypeCons
TypeImport
False
(
qualifyWith
mid
t
)
:
map
(
DataCons
ConsImport
False
.
qualifyWith
mid
)
cs
idsImport
mid
(
ImportTypeAll
t
)
=
[
TypeCons
TypeImport
$
qualifyWith
mid
t
]
[
TypeCons
TypeImport
False
$
qualifyWith
mid
t
]
-- Declarations
idsDecl
::
Decl
->
[
Code
]
idsDecl
(
InfixDecl
_
_
_
ops
)
=
map
(
Function
FuncInfix
.
qualify
)
ops
idsDecl
(
DataDecl
_
d
vs
cds
)
=
TypeCons
TypeDeclare
(
qualify
d
)
:
map
(
Identifier
IdDeclare
.
qualify
)
vs
idsDecl
(
InfixDecl
_
_
_
ops
)
=
map
(
Function
FuncInfix
False
.
qualify
)
ops
idsDecl
(
DataDecl
_
d
vs
cds
)
=
TypeCons
TypeDeclare
False
(
qualify
d
)
:
map
(
Identifier
IdDeclare
False
.
qualify
)
vs
++
concatMap
idsConstrDecl
cds
idsDecl
(
NewtypeDecl
_
t
vs
nc
)
=
TypeCons
TypeDeclare
(
qualify
t
)
:
map
(
Identifier
IdDeclare
.
qualify
)
vs
idsDecl
(
NewtypeDecl
_
t
vs
nc
)
=
TypeCons
TypeDeclare
False
(
qualify
t
)
:
map
(
Identifier
IdDeclare
False
.
qualify
)
vs
++
idsNewConstrDecl
nc
idsDecl
(
TypeDecl
_
t
vs
ty
)
=
TypeCons
TypeDeclare
(
qualify
t
)
:
map
(
Identifier
IdDeclare
.
qualify
)
vs
idsDecl
(
TypeDecl
_
t
vs
ty
)
=
TypeCons
TypeDeclare
False
(
qualify
t
)
:
map
(
Identifier
IdDeclare
False
.
qualify
)
vs
++
idsTypeExpr
ty
idsDecl
(
TypeSig
_
fs
ty
)
=
map
(
Function
FuncTypeSig
.
qualify
)
fs
idsDecl
(
TypeSig
_
fs
ty
)
=
map
(
Function
FuncTypeSig
False
.
qualify
)
fs
++
idsTypeExpr
ty
idsDecl
(
FunctionDecl
_
_
eqs
)
=
concatMap
idsEquation
eqs
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
(
FreeDecl
_
vs
)
=
map
(
Identifier
IdDeclare
.
qualify
)
vs
idsDecl
(
FreeDecl
_
vs
)
=
map
(
Identifier
IdDeclare
False
.
qualify
)
vs
idsConstrDecl
::
ConstrDecl
->
[
Code
]
idsConstrDecl
(
ConstrDecl
_
_
c
tys
)
=
DataCons
ConsDeclare
(
qualify
c
)
:
concatMap
idsTypeExpr
tys
=
DataCons
ConsDeclare
False
(
qualify
c
)
:
concatMap
idsTypeExpr
tys
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
)
=
DataCons
ConsDeclare
(
qualify
c
)
:
concatMap
idsFieldDecl
fs
=
DataCons
ConsDeclare
False
(
qualify
c
)
:
concatMap
idsFieldDecl
fs
idsNewConstrDecl
::
NewConstrDecl
->
[
Code
]
idsNewConstrDecl
(
NewConstrDecl
_
_
c
ty
)
=
DataCons
ConsDeclare
(
qualify
c
)
:
idsTypeExpr
ty
=
DataCons
ConsDeclare
False
(
qualify
c
)
:
idsTypeExpr
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
::
TypeExpr
->
[
Code
]
idsTypeExpr
(
ConstructorType
qid
tys
)
=
TypeCons
TypeRefer
qid
:
idsTypeExpr
(
ConstructorType
qid
tys
)
=
TypeCons
TypeRefer
False
qid
:
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
(
ListType
ty
)
=
idsTypeExpr
ty
idsTypeExpr
(
ArrowType
ty1
ty2
)
=
concatMap
idsTypeExpr
[
ty1
,
ty2
]
...
...
@@ -310,14 +354,14 @@ idsTypeExpr (ParenType ty) = idsTypeExpr ty
idsFieldDecl
::
FieldDecl
->
[
Code
]
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
_
lhs
rhs
)
=
idsLhs
lhs
++
idsRhs
rhs
idsLhs
::
Lhs
->
[
Code
]
idsLhs
(
FunLhs
f
ps
)
=
Function
FuncDeclare
(
qualify
f
)
:
concatMap
idsPat
ps
idsLhs
(
OpLhs
p1
op
p2
)
=
idsPat
p1
++
[
Function
FuncDeclare
$
qualify
op
]
idsLhs
(
FunLhs
f
ps
)
=
Function
FuncDeclare
False
(
qualify
f
)
:
concatMap
idsPat
ps
idsLhs
(
OpLhs
p1
op
p2
)
=
idsPat
p1
++
[
Function
FuncDeclare
False
$
qualify
op
]
++
idsPat
p2
idsLhs
(
ApLhs
lhs
ps
)
=
idsLhs
lhs
++
concatMap
idsPat
ps
...
...
@@ -331,33 +375,33 @@ idsCondExpr (CondExpr _ e1 e2) = idsExpr e1 ++ idsExpr e2
idsPat
::
Pattern
->
[
Code
]
idsPat
(
LiteralPattern
_
)
=
[]
idsPat
(
NegativePattern
_
_
)
=
[]
idsPat
(
VariablePattern
v
)
=
[
Identifier
IdDeclare
(
qualify
v
)]
idsPat
(
ConstructorPattern
qid
ps
)
=
DataCons
ConsPattern
qid
idsPat
(
VariablePattern
v
)
=
[
Identifier
IdDeclare
False
(
qualify
v
)]
idsPat
(
ConstructorPattern
qid
ps
)
=
DataCons
ConsPattern
False
qid
:
concatMap
idsPat
ps
idsPat
(
InfixPattern
p1
qid
p2
)
=
idsPat
p1
++
DataCons
ConsPattern
qid
:
idsPat
p2
DataCons
ConsPattern
False
qid
:
idsPat
p2
idsPat
(
ParenPattern
p
)
=
idsPat
p
idsPat
(
RecordPattern
qid
fs
)
=
DataCons
ConsPattern
qid
idsPat
(
RecordPattern
qid
fs
)
=
DataCons
ConsPattern
False
qid
:
concatMap
(
idsField
idsPat
)
fs
idsPat
(
TuplePattern
_
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
(
FunctionPattern
qid
ps
)
=
Function
FuncCall
qid
idsPat
(
FunctionPattern
qid
ps
)
=
Function
FuncCall
False
qid
:
concatMap
idsPat
ps
idsPat
(
InfixFuncPattern
p1
f
p2
)
=
idsPat
p1
++
Function
FuncInfix
f
:
idsPat
p2
Function
FuncInfix
False
f
:
idsPat
p2
idsExpr
::
Expression
->
[
Code
]
idsExpr
(
Literal
_
)
=
[]
idsExpr
(
Variable
qid
)
|
isQualified
qid
=
[
Function
FuncCall
qid
]
|
hasGlobalScope
(
unqualify
qid
)
=
[
Function
FuncCall
qid
]
|
otherwise
=
[
Identifier
IdRefer
qid
]
idsExpr
(
Constructor
qid
)
=
[
DataCons
ConsCall
qid
]
|
isQualified
qid
=
[
Function
FuncCall
False
qid
]
|
hasGlobalScope
(
unqualify
qid
)
=
[
Function
FuncCall
False
qid
]
|
otherwise
=
[
Identifier
IdRefer
False
qid
]
idsExpr
(
Constructor
qid
)
=
[
DataCons
ConsCall
False
qid
]
idsExpr
(
Paren
e
)
=
idsExpr
e
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
idsExpr
(
RecordUpdate
e
fs
)
=
idsExpr
e
++
concatMap
(
idsField
idsExpr
)
fs
...
...
@@ -380,11 +424,11 @@ idsExpr (IfThenElse _ e1 e2 e3) = concatMap idsExpr [e1, e2, e3]
idsExpr
(
Case
_
_
e
alts
)
=
idsExpr
e
++
concatMap
idsAlt
alts
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
qid
)
=
[
Function
FuncInfix
qid
]
idsInfix
(
InfixConstr
qid
)
=
[
DataCons
ConsInfix
qid
]
idsInfix
(
InfixOp
qid
)
=
[
Function
FuncInfix
False
qid
]
idsInfix
(
InfixConstr
qid
)
=
[
DataCons
ConsInfix
False
qid
]
idsStmt
::
Statement
->
[
Code
]
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