Skip to content
GitLab
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
74844cea
Commit
74844cea
authored
Aug 13, 2012
by
Björn Peemöller
Browse files
Improved generation of HTML documentation
parent
5c92a0cb
Changes
3
Hide whitespace changes
Inline
Side-by-side
src/Frontend.hs
View file @
74844cea
...
...
@@ -12,91 +12,71 @@
This module provides an API for dealing with several kinds of Curry
program representations.
-}
module
Frontend
(
parse
,
fullParse
)
where
-- TODO: Should be updated/refactored
import
Control.Monad.Writer
import
Data.Maybe
(
mapMaybe
)
import
qualified
Data.Map
as
Map
(
empty
)
module
Frontend
(
parse
,
fullParse
,
typingParse
)
where
import
Data.Maybe
(
mapMaybe
)
import
qualified
Data.Map
as
Map
(
empty
)
import
Control.Monad.Writer
import
Curry.Base.MessageMonad
import
Curry.Files.Filenames
import
Curry.Files.PathUtils
import
Curry.Syntax
(
Module
(
..
),
parseModule
)
import
Checks
import
CompilerEnv
import
CompilerOpts
(
Options
(
..
),
Verbosity
(
..
),
TargetType
(
..
),
defaultOptions
)
import
Checks
(
CheckResult
(
..
))
import
CompilerOpts
(
Options
(
..
),
defaultOptions
)
import
CurryBuilder
(
smake
)
import
CurryDeps
(
Source
(
..
),
flattenDeps
,
moduleDeps
)
import
Imports
(
importModules
)
import
Interfaces
(
loadInterfaces
)
import
Modules
import
CurryDeps
(
Source
(
..
),
flattenDeps
,
moduleDeps
)
import
Modules
(
checkModule
,
checkModuleHeader
,
compileModule
,
loadModule
)
{- |Return the result of a syntactical analysis of the source program 'src'.
The result is the syntax tree of the program (type 'Module'; see Module
"CurrySyntax").
-}
parse
::
FilePath
->
String
->
MsgMonad
Module
parse
fn
src
=
parseModule
True
fn
src
>>=
genCurrySyntax
fn
parse
fn
src
=
parseModule
True
fn
src
>>=
genCurrySyntax
where
genCurrySyntax
mod1
|
null
hdrErrs
=
return
mdl
|
otherwise
=
failWith
$
show
$
head
hdrErrs
where
(
mdl
,
hdrErrs
)
=
checkModuleHeader
defaultOptions
fn
mod1
{- |Return the syntax tree of the source program 'src' (type 'Module'; see
Module "CurrySyntax")
after
resolv
ing the
category (i.e. function,
constructor or variable) of an identifier. 'fullParse' always
searches for standard Curry libraries in the path
defined in the
Module "CurrySyntax")
.
after
inferr
ing the
types of identifiers.
'fullParse' always searches for standard Curry libraries in the path
defined in the
environment variable "PAKCSLIBPATH". Additional search paths can
be defined using the argument 'paths'.
-}
fullParse
::
[
FilePath
]
->
FilePath
->
String
->
IO
(
MsgMonad
Module
)
fullParse
paths
fn
src
=
genFullCurrySyntax
checkModule
paths
fn
$
parse
fn
src
{- |Behaves like 'fullParse', but returns the syntax tree of the source
program 'src' (type 'Module'; see Module "CurrySyntax") after inferring
the types of identifiers.
-}
typingParse
::
[
FilePath
]
->
FilePath
->
String
->
IO
(
MsgMonad
Module
)
typingParse
paths
fn
src
=
genFullCurrySyntax
checkModule
paths
fn
$
parse
fn
src
fullParse
::
Options
->
FilePath
->
String
->
IO
(
MsgMonad
Module
)
fullParse
opts
fn
src
=
genFullCurrySyntax
opts
fn
$
parse
fn
src
--
genCurrySyntax
::
FilePath
->
Module
->
MsgMonad
Module
genCurrySyntax
fn
mod1
|
null
hdrErrs
=
return
mdl
|
otherwise
=
failWith
$
show
$
head
hdrErrs
where
(
mdl
,
hdrErrs
)
=
checkModuleHeader
defaultOptions
fn
mod1
--
genFullCurrySyntax
::
(
Options
->
CompilerEnv
->
Module
->
CheckResult
(
CompilerEnv
,
Module
))
->
[
FilePath
]
->
FilePath
->
MsgMonad
Module
->
IO
(
MsgMonad
Module
)
genFullCurrySyntax
check
paths
fn
m
=
runMsgIO
m
$
\
mod1
->
do
errs
<-
makeInterfaces
paths
fn
mod1
genFullCurrySyntax
::
Options
->
FilePath
->
MsgMonad
Module
->
IO
(
MsgMonad
Module
)
genFullCurrySyntax
opts
fn
m
=
runMsgIO
m
$
\
mod1
->
do
errs
<-
makeInterfaces
opts
fn
mod1
if
null
errs
then
do
(
iEnv
,
intfErrs
)
<-
loadInterfaces
paths
mod1
unless
(
null
intfErrs
)
$
failWith
$
msgTxt
$
head
intfErrs
let
env
=
importModules
opts
mod1
iEnv
case
check
opts
env
mod1
of
CheckSuccess
(
_
,
mod'
)
->
return
(
return
mod'
)
loaded
<-
loadModule
opts
fn
case
checkModule
opts
loaded
of
CheckFailed
errs'
->
return
$
failWith
$
msgTxt
$
head
errs'
CheckSuccess
(
_
,
mod'
)
->
return
(
return
mod'
)
else
return
$
failWith
$
head
errs
where
opts
=
mkOpts
paths
-- TODO: Resembles CurryBuilder
-- Generates interface files for importes modules, if they don't exist or
-- if they are not up-to-date.
makeInterfaces
::
[
FilePath
]
->
FilePath
->
Module
->
IO
[
String
]
makeInterfaces
path
s
fn
mdl
=
do
(
deps1
,
errs
)
<-
fmap
flattenDeps
$
moduleDeps
(
mkOpts
paths
)
Map
.
empty
fn
mdl
makeInterfaces
::
Options
->
FilePath
->
Module
->
IO
[
String
]
makeInterfaces
opt
s
fn
mdl
=
do
(
deps1
,
errs
)
<-
fmap
flattenDeps
$
moduleDeps
opts
Map
.
empty
fn
mdl
when
(
null
errs
)
$
mapM_
(
compile
deps1
.
snd
)
deps1
return
errs
where
compile
deps'
(
Source
file'
mods
)
=
smake
[
flatName
file'
,
flatIntName
file'
]
(
file'
:
mapMaybe
(
flatInterface
deps'
)
mods
)
(
compileModule
(
mkOpts
paths
)
file'
)
(
compileModule
opts
file'
)
(
return
()
)
compile
_
_
=
return
()
...
...
@@ -104,11 +84,3 @@ makeInterfaces paths fn mdl = do
Just
(
Source
f
_
)
->
Just
$
flatIntName
$
dropExtension
f
Just
(
Interface
f
)
->
Just
$
flatIntName
$
dropExtension
f
_
->
Nothing
mkOpts
::
[
FilePath
]
->
Options
mkOpts
paths
=
defaultOptions
{
optImportPaths
=
paths
,
optVerbosity
=
VerbQuiet
,
optWarn
=
False
,
optTargetTypes
=
[
AbstractCurry
]
}
src/Html/CurryHtml.hs
View file @
74844cea
...
...
@@ -24,8 +24,9 @@ import Curry.Syntax (lexFile)
import
Html.SyntaxColoring
import
CompilerOpts
(
Options
(
..
))
import
Frontend
(
parse
,
typingParse
,
fullParse
)
import
Base.Messages
(
abortWith
)
import
CompilerOpts
(
Options
(
..
),
TargetType
(
..
))
import
Frontend
(
parse
,
fullParse
)
--- translate source file into HTML file with syntaxcoloring
...
...
@@ -41,7 +42,7 @@ source2html opts sourcefilename = do
else
outputfilename
modulname
=
takeFileName
sourceprogname
fullfname
<-
lookupCurryFile
imports
sourcefilename
program
<-
filename2program
impor
ts
(
fromMaybe
sourcefilename
fullfname
)
program
<-
filename2program
op
ts
(
fromMaybe
sourcefilename
fullfname
)
(
if
null
outputfilename
then
writeModule
True
output'
else
writeFile
output'
)
(
program2html
modulname
program
)
...
...
@@ -49,14 +50,17 @@ source2html opts sourcefilename = do
--- @param importpaths
--- @param filename
--- @return program
filename2program
::
[
String
]
->
String
->
IO
Program
filename2program
paths
filename
=
do
(
Just
cont
)
<-
readModule
filename
typingParseRes
<-
catchError
$
typingParse
paths
filename
cont
fullParseRes
<-
catchError
$
fullParse
paths
filename
cont
parseRes
<-
catchError
$
return
(
parse
filename
cont
)
lexRes
<-
catchError
$
return
(
lexFile
filename
cont
)
return
$
genProgram
cont
[
typingParseRes
,
fullParseRes
,
parseRes
]
lexRes
filename2program
::
Options
->
String
->
IO
Program
filename2program
opts
filename
=
do
mbModule
<-
readModule
filename
case
mbModule
of
Nothing
->
abortWith
[
"Missing file: "
++
filename
]
Just
cont
->
do
typingParseRes
<-
catchError
$
fullParse
opts
filename
cont
fullParseRes
<-
catchError
$
fullParse
(
opts
{
optTargetTypes
=
[
UntypedAbstractCurry
]})
filename
cont
parseRes
<-
catchError
$
return
(
parse
filename
cont
)
lexRes
<-
catchError
$
return
(
lexFile
filename
cont
)
return
$
genProgram
cont
[
typingParseRes
,
fullParseRes
,
parseRes
]
lexRes
--- this function intercepts errors and converts it to Messages
...
...
src/Modules.hs
View file @
74844cea
...
...
@@ -15,7 +15,7 @@
-}
module
Modules
(
compileModule
,
loadModule
,
checkModuleHeader
,
checkModule
(
compileModule
,
loadModule
,
checkModuleHeader
,
checkModule
,
writeOutput
)
where
import
Control.Monad
(
unless
,
when
)
...
...
@@ -73,26 +73,30 @@ import Transformations
compileModule
::
Options
->
FilePath
->
IO
()
compileModule
opts
fn
=
do
loaded
<-
loadModule
opts
fn
case
uncurry
(
checkModule
opts
)
loaded
of
case
checkModule
opts
loaded
of
CheckFailed
errs
->
abortWith
$
map
show
errs
CheckSuccess
(
env
,
modul
)
->
do
showWarnings
opts
$
uncurry
warnCheck
loaded
writeParsed
opts
fn
modul
writeAbstractCurry
opts
fn
env
modul
when
withFlat
$
do
-- checkModule checks types, and then transModule introduces new
-- functions (by lambda lifting in 'desugar'). Consequence: The
-- types of the newly introduced functions are not inferred (hsi)
let
(
env2
,
il
,
dumps
)
=
transModule
opts
env
modul
-- dump intermediate results
mapM_
(
doDump
opts
)
dumps
-- generate target code
let
intf
=
exportInterface
env2
modul
let
modSum
=
summarizeModule
(
tyConsEnv
env2
)
intf
modul
writeFlat
opts
fn
env2
modSum
il
where
withFlat
=
any
(`
elem
`
optTargetTypes
opts
)
[
FlatCurry
,
FlatXml
,
ExtendedFlatCurry
]
CheckSuccess
res
->
do
showWarnings
opts
$
uncurry
warnCheck
res
writeOutput
opts
fn
res
writeOutput
::
Options
->
FilePath
->
(
CompilerEnv
,
CS
.
Module
)
->
IO
()
writeOutput
opts
fn
(
env
,
modul
)
=
do
writeParsed
opts
fn
modul
writeAbstractCurry
opts
fn
env
modul
when
withFlat
$
do
-- checkModule checks types, and then transModule introduces new
-- functions (by lambda lifting in 'desugar'). Consequence: The
-- types of the newly introduced functions are not inferred (hsi)
let
(
env2
,
il
,
dumps
)
=
transModule
opts
env
modul
-- dump intermediate results
mapM_
(
doDump
opts
)
dumps
-- generate target code
let
intf
=
exportInterface
env2
modul
let
modSum
=
summarizeModule
(
tyConsEnv
env2
)
intf
modul
writeFlat
opts
fn
env2
modSum
il
where
withFlat
=
any
(`
elem
`
optTargetTypes
opts
)
[
FlatCurry
,
FlatXml
,
ExtendedFlatCurry
]
-- ---------------------------------------------------------------------------
-- Loading a module
...
...
@@ -119,7 +123,7 @@ loadModule opts fn = do
checkModuleHeader
::
Options
->
FilePath
->
CS
.
Module
->
(
CS
.
Module
,
[
Message
])
checkModuleHeader
opts
fn
=
checkModuleId
fn
.
importPrelude
opts
.
importPrelude
opts
fn
.
CS
.
patchModuleId
fn
-- |Check whether the 'ModuleIdent' and the 'FilePath' fit together
...
...
@@ -135,8 +139,8 @@ checkModuleId fn m@(CS.Module mid _ _ _)
-- by a compiler option. If no explicit import for the prelude is present,
-- the prelude is imported unqualified, otherwise a qualified import is added.
importPrelude
::
Options
->
CS
.
Module
->
CS
.
Module
importPrelude
opts
m
@
(
CS
.
Module
mid
es
is
ds
)
importPrelude
::
Options
->
FilePath
->
CS
.
Module
->
CS
.
Module
importPrelude
opts
fn
m
@
(
CS
.
Module
mid
es
is
ds
)
-- the Prelude itself
|
mid
==
preludeMIdent
=
m
-- disabled by compiler option
...
...
@@ -147,7 +151,7 @@ importPrelude opts m@(CS.Module mid es is ds)
|
otherwise
=
CS
.
Module
mid
es
(
preludeImp
:
is
)
ds
where
noImpPrelude
=
NoImplicitPrelude
`
elem
`
optExtensions
opts
preludeImp
=
CS
.
ImportDecl
NoPos
preludeMIdent
preludeImp
=
CS
.
ImportDecl
(
first
fn
)
preludeMIdent
False
-- qualified?
Nothing
-- no alias
Nothing
-- no selection of types, functions, etc.
...
...
@@ -161,18 +165,19 @@ importPrelude opts m@(CS.Module mid es is ds)
-- TODO (2012-01-05, bjp): The export specification check for untyped
-- AbstractCurry is deactivated as it requires the value information
-- collected by the type checker.
checkModule
::
Options
->
CompilerEnv
->
CS
.
Module
checkModule
::
Options
->
(
CompilerEnv
,
CS
.
Module
)
->
CheckResult
(
CompilerEnv
,
CS
.
Module
)
checkModule
opts
env
mdl
=
kindCheck
env
mdl
-- should be only syntax checking ?
>>=
uncurry
(
syntaxCheck
opts
)
>>=
uncurry
precCheck
>>=
(
if
withTypeCheck
then
\
x
->
uncurry
typeCheck
x
>>=
uncurry
exportCheck
else
return
)
>>=
return
.
(
uncurry
(
qual
opts
))
checkModule
opts
(
env
,
mdl
)
=
kindCheck
env
mdl
-- should be only syntax checking ?
>>=
uncurry
(
syntaxCheck
opts
)
>>=
uncurry
precCheck
>>=
(
if
withTypeCheck
then
\
x
->
uncurry
typeCheck
x
>>=
uncurry
exportCheck
else
return
)
>>=
return
.
(
uncurry
(
qual
opts
))
where
withTypeCheck
=
any
(`
elem
`
optTargetTypes
opts
)
[
FlatCurry
,
ExtendedFlatCurry
,
FlatXml
,
AbstractCurry
]
withTypeCheck
=
any
(`
elem
`
optTargetTypes
opts
)
[
FlatCurry
,
ExtendedFlatCurry
,
FlatXml
,
AbstractCurry
]
-- ---------------------------------------------------------------------------
-- Translating a module
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new 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