Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
7
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Open sidebar
curry
curry-frontend
Commits
34d80ff7
Commit
34d80ff7
authored
Oct 09, 2014
by
Björn Peemöller
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Adapted new behaviour in Curry file retrieval to allow hierarchical modules
parent
a701c13f
Changes
5
Hide whitespace changes
Inline
Side-by-side
Showing
5 changed files
with
38 additions
and
28 deletions
+38
-28
src/CompilerOpts.hs
src/CompilerOpts.hs
+5
-2
src/CurryBuilder.hs
src/CurryBuilder.hs
+9
-6
src/CurryDeps.hs
src/CurryDeps.hs
+1
-1
src/Html/CurryHtml.hs
src/Html/CurryHtml.hs
+1
-1
src/Modules.hs
src/Modules.hs
+22
-18
No files found.
src/CompilerOpts.hs
View file @
34d80ff7
...
...
@@ -26,7 +26,8 @@ import Data.List (intercalate, nub)
import
Data.Maybe
(
isJust
)
import
System.Console.GetOpt
import
System.Environment
(
getArgs
,
getProgName
)
import
System.FilePath
(
splitSearchPath
)
import
System.FilePath
(
addTrailingPathSeparator
,
normalise
,
splitSearchPath
)
import
Curry.Files.Filenames
(
currySubdir
)
import
Curry.Syntax.Extension
...
...
@@ -324,7 +325,9 @@ options =
"search for libraries in dir[:dir]"
,
Option
"i"
[
"import-dir"
]
(
ReqArg
(
withArg
onOpts
$
\
arg
opts
->
opts
{
optImportPaths
=
nub
$
optImportPaths
opts
++
splitSearchPath
arg
})
"dir[:dir]"
)
nub
$
optImportPaths
opts
++
map
(
normalise
.
addTrailingPathSeparator
)
(
splitSearchPath
arg
)
})
"dir[:dir]"
)
"search for imports in dir[:dir]"
,
Option
[]
[
"htmldir"
]
(
ReqArg
(
withArg
onOpts
$
\
arg
opts
->
opts
{
optHtmlDir
=
...
...
src/CurryBuilder.hs
View file @
34d80ff7
...
...
@@ -57,7 +57,7 @@ findCurry opts s = do
canBeFile
=
isCurryFilePath
s
canBeModule
=
isValidModuleName
s
moduleFile
=
moduleNameToFile
$
fromModuleName
s
paths
=
optImportPaths
opts
paths
=
"."
:
optImportPaths
opts
findFile
=
if
canBeFile
then
liftIO
$
lookupCurryFile
paths
s
else
return
Nothing
...
...
@@ -79,7 +79,8 @@ findCurry opts s = do
makeCurry
::
Options
->
[(
ModuleIdent
,
Source
)]
->
CYIO
()
makeCurry
opts
srcs
=
mapM_
process'
(
zip
[
1
..
]
srcs
)
where
total
=
length
srcs
total
=
length
srcs
tgtDir
m
=
addCurrySubdirModule
(
optUseSubdir
opts
)
m
process'
::
(
Int
,
(
ModuleIdent
,
Source
))
->
CYIO
()
process'
(
n
,
(
m
,
Source
fn
ps
is
))
=
do
...
...
@@ -89,8 +90,8 @@ makeCurry opts srcs = mapM_ process' (zip [1 ..] srcs)
deps
=
fn
:
mapMaybe
curryInterface
is
curryInterface
i
=
case
lookup
i
srcs
of
Just
(
Source
fn'
_
_
)
->
Just
$
interfName
fn'
Just
(
Interface
fn'
)
->
Just
$
interfName
fn'
Just
(
Source
fn'
_
_
)
->
Just
$
tgtDir
i
$
interfName
fn'
Just
(
Interface
fn'
)
->
Just
$
tgtDir
i
$
interfName
fn'
_
->
Nothing
process'
_
=
return
()
...
...
@@ -147,14 +148,16 @@ process :: Options -> (Int, Int)
->
ModuleIdent
->
FilePath
->
[
FilePath
]
->
CYIO
()
process
opts
idx
m
fn
deps
|
optForce
opts
=
compile
|
otherwise
=
smake
(
interfName
fn
:
destFiles
)
deps
compile
skip
|
otherwise
=
smake
(
tgtDir
(
interfName
fn
)
:
destFiles
)
deps
compile
skip
where
skip
=
status
opts
$
compMessage
idx
"Skipping"
m
(
fn
,
head
destFiles
)
compile
=
do
status
opts
$
compMessage
idx
"Compiling"
m
(
fn
,
head
destFiles
)
compileModule
opts
fn
destFiles
=
[
addCurrySubdir
(
optUseSubdir
opts
)
(
gen
fn
)
tgtDir
=
addCurrySubdirModule
(
optUseSubdir
opts
)
m
destFiles
=
[
tgtDir
(
gen
fn
)
|
(
tgt
,
gen
)
<-
nameGens
,
tgt
`
elem
`
optTargetTypes
opts
]
nameGens
=
[
(
FlatCurry
,
flatName
)
...
...
src/CurryDeps.hs
View file @
34d80ff7
...
...
@@ -115,7 +115,7 @@ moduleIdentDeps :: Options -> SourceEnv -> ModuleIdent -> CYIO SourceEnv
moduleIdentDeps
opts
sEnv
m
=
case
Map
.
lookup
m
sEnv
of
Just
_
->
return
sEnv
Nothing
->
do
mFile
<-
liftIO
$
lookupCurryModule
(
optImportPaths
opts
)
mFile
<-
liftIO
$
lookupCurryModule
(
"."
:
optImportPaths
opts
)
(
optLibraryPaths
opts
)
m
case
mFile
of
Nothing
->
return
$
Map
.
insert
m
Unknown
sEnv
...
...
src/Html/CurryHtml.hs
View file @
34d80ff7
...
...
@@ -39,9 +39,9 @@ source2html opts f = do
let
baseName
=
takeBaseName
f
outDir
=
fromMaybe
(
dropFileName
f
)
$
optHtmlDir
opts
outFile
=
outDir
</>
baseName
++
"_curry.html"
srcFile
<-
liftIO
$
lookupCurryFile
(
optImportPaths
opts
)
f
program
<-
filename2program
opts
(
fromMaybe
f
srcFile
)
liftIO
$
writeFile
outFile
(
program2html
baseName
program
)
srcFile
<-
liftIO
$
lookupCurryFile
(
"."
:
optImportPaths
opts
)
f
-- @param importpaths
-- @param filename
...
...
src/Modules.hs
View file @
34d80ff7
...
...
@@ -96,7 +96,9 @@ loadModule opts fn = do
-- check module header
mdl
<-
checkModuleHeader
opts
fn
parsed
-- load the imported interfaces into an InterfaceEnv
iEnv
<-
loadInterfaces
(
optImportPaths
opts
)
mdl
let
paths
=
map
(
addCurrySubdir
(
optUseSubdir
opts
))
(
"."
:
optImportPaths
opts
)
iEnv
<-
loadInterfaces
paths
mdl
checkInterfaces
opts
iEnv
-- add information of imported modules
cEnv
<-
importModules
opts
mdl
iEnv
...
...
@@ -267,15 +269,15 @@ writeOutput opts fn (env, modul) = do
-- |Output the parsed 'Module' on request
writeParsed
::
Options
->
FilePath
->
CS
.
Module
->
IO
()
writeParsed
opts
fn
modul
=
when
srcTarget
$
writeModule
useSubDir
(
sourceRepName
fn
)
source
writeParsed
opts
fn
modul
@
(
CS
.
Module
_
m
_
_
_
)
=
when
srcTarget
$
writeModule
(
useSubDir
$
sourceRepName
fn
)
source
where
srcTarget
=
Parsed
`
elem
`
optTargetTypes
opts
useSubDir
=
optUseSubdir
opts
useSubDir
=
addCurrySubdirModule
(
optUseSubdir
opts
)
m
source
=
CS
.
showModule
modul
writeInterface
::
Options
->
FilePath
->
CS
.
Interface
->
IO
()
writeInterface
opts
fn
intf
writeInterface
opts
fn
intf
@
(
CS
.
Interface
m
_
_
)
|
optForce
opts
=
outputInterface
|
otherwise
=
do
equal
<-
C
.
catch
(
matchInterface
interfaceFile
intf
)
ignoreIOException
...
...
@@ -285,7 +287,8 @@ writeInterface opts fn intf
ignoreIOException
_
=
return
False
interfaceFile
=
interfName
fn
outputInterface
=
writeModule
(
optUseSubdir
opts
)
interfaceFile
outputInterface
=
writeModule
(
addCurrySubdirModule
(
optUseSubdir
opts
)
m
interfaceFile
)
(
show
$
CS
.
ppInterface
intf
)
matchInterface
::
FilePath
->
CS
.
Interface
->
IO
Bool
...
...
@@ -303,19 +306,19 @@ writeFlat opts fn env modSum il = do
writeFlatCurry
opts
fn
env
modSum
il
writeFlatIntf
opts
fn
env
modSum
il
where
extTarget
=
ExtendedFlatCurry
`
elem
`
optTargetTypes
opts
fcyTarget
=
FlatCurry
`
elem
`
optTargetTypes
opts
extTarget
=
ExtendedFlatCurry
`
elem
`
optTargetTypes
opts
fcyTarget
=
FlatCurry
`
elem
`
optTargetTypes
opts
-- |Export an 'IL.Module' into a FlatCurry file
writeFlatCurry
::
Options
->
FilePath
->
CompilerEnv
->
ModuleSummary
->
IL
.
Module
->
IO
()
writeFlatCurry
opts
fn
env
modSum
il
=
do
when
extTarget
$
EF
.
writeExtendedFlat
useSubDir
(
extFlatName
fn
)
prog
when
fcyTarget
$
EF
.
writeFlatCurry
useSubDir
(
flatName
fn
)
prog
when
extTarget
$
EF
.
writeExtendedFlat
(
useSubDir
$
extFlatName
fn
)
prog
when
fcyTarget
$
EF
.
writeFlatCurry
(
useSubDir
$
flatName
fn
)
prog
where
extTarget
=
ExtendedFlatCurry
`
elem
`
optTargetTypes
opts
fcyTarget
=
FlatCurry
`
elem
`
optTargetTypes
opts
useSubDir
=
optUseSubdir
opts
useSubDir
=
addCurrySubdirModule
(
optUseSubdir
opts
)
(
moduleIdent
env
)
prog
=
genFlatCurry
modSum
env
il
writeFlatIntf
::
Options
->
FilePath
->
CompilerEnv
->
ModuleSummary
...
...
@@ -329,21 +332,22 @@ writeFlatIntf opts fn env modSum il
when
(
mfint
==
mfint
)
$
return
()
-- necessary to close file -- TODO
unless
(
oldInterface
`
eqInterface
`
intf
)
$
outputInterface
where
targetFile
=
flatIntName
fn
emptyIntf
=
EF
.
Prog
""
[]
[]
[]
[]
intf
=
genFlatInterface
modSum
env
il
outputInterface
=
EF
.
writeFlatCurry
(
optUseSubdir
opts
)
targetFile
intf
targetFile
=
flatIntName
fn
emptyIntf
=
EF
.
Prog
""
[]
[]
[]
[]
intf
=
genFlatInterface
modSum
env
il
useSubDir
=
addCurrySubdirModule
(
optUseSubdir
opts
)
(
moduleIdent
env
)
outputInterface
=
EF
.
writeFlatCurry
(
useSubDir
targetFile
)
intf
writeAbstractCurry
::
Options
->
FilePath
->
CompilerEnv
->
CS
.
Module
->
IO
()
writeAbstractCurry
opts
fname
env
modul
=
do
when
acyTarget
$
AC
.
writeCurry
useSubDir
(
acyName
fname
)
when
acyTarget
$
AC
.
writeCurry
(
useSubDir
$
acyName
fname
)
$
genTypedAbstractCurry
env
modul
when
uacyTarget
$
AC
.
writeCurry
useSubDir
(
uacyName
fname
)
when
uacyTarget
$
AC
.
writeCurry
(
useSubDir
$
uacyName
fname
)
$
genUntypedAbstractCurry
env
modul
where
acyTarget
=
AbstractCurry
`
elem
`
optTargetTypes
opts
uacyTarget
=
UntypedAbstractCurry
`
elem
`
optTargetTypes
opts
useSubDir
=
optUseSubdir
opts
useSubDir
=
addCurrySubdirModule
(
optUseSubdir
opts
)
(
moduleIdent
env
)
type
Dump
=
(
DumpLevel
,
CompilerEnv
,
String
)
...
...
Write
Preview
Markdown
is supported
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