Commit 0b9702b7 authored by Michael Hanus 's avatar Michael Hanus

Update CPM, fix bug in binding optimizer w.r.t. hierarchical imported modules

parent 340fd1c7
......@@ -6,7 +6,8 @@
module CPM.Config
( Config ( Config, packageInstallDir, binInstallDir, repositoryDir
, appPackageDir, packageIndexURL, homePackageDir, curryExec
, appPackageDir, packageIndexURL, packageTarFilesURL
, homePackageDir, curryExec
, compilerVersion, compilerBaseVersion, baseVersion )
, readConfigurationWith, defaultConfig
, showConfiguration, showCompilerVersion ) where
......@@ -36,6 +37,11 @@ packageIndexDefaultURL =
-- If you have an ssh access to git.ps.informatik.uni-kiel.de:
-- "ssh://git@git.ps.informatik.uni-kiel.de:55055/curry-packages/cpm-index.git"
--- The default URL prefix to the directory containing tar files of all packages
packageTarFilesDefaultURL :: String
packageTarFilesDefaultURL =
"https://www-ps.informatik.uni-kiel.de/~pakcs/CPM_PACKAGES/"
--- Data type containing the main configuration of CPM.
data Config = Config {
--- The directory where locally installed packages are stored
......@@ -48,6 +54,8 @@ data Config = Config {
, appPackageDir :: String
--- URL to the package index repository
, packageIndexURL :: String
--- URL prefix to the directory containing tar files of all packages
, packageTarFilesURL :: String
--- The directory where the default home package is stored
, homePackageDir :: String
--- The executable of the Curry system used to compile and check packages
......@@ -69,6 +77,7 @@ defaultConfig = Config
, repositoryDir = "$HOME/.cpm/index"
, appPackageDir = ""
, packageIndexURL = packageIndexDefaultURL
, packageTarFilesURL = packageTarFilesDefaultURL
, homePackageDir = ""
, curryExec = Dist.installDir </> "bin" </> Dist.curryCompiler
, compilerVersion = ( Dist.curryCompiler
......@@ -92,6 +101,7 @@ showConfiguration cfg = unlines
, "APP_PACKAGE_PATH : " ++ appPackageDir cfg
, "HOME_PACKAGE_PATH : " ++ homePackageDir cfg
, "PACKAGE_INDEX_URL : " ++ packageIndexURL cfg
, "PACKAGE_TARFILES_URL : " ++ packageTarFilesURL cfg
]
--- Shows the compiler version in the configuration.
......@@ -259,14 +269,15 @@ stripProps = map ((map toUpper . filter (/='_') . strip) *** strip)
--- record with a value for that option.
keySetters :: [(String, String -> Config -> Config)]
keySetters =
[ ("APPPACKAGEPATH" , \v c -> c { appPackageDir = v })
, ("BASEVERSION" , \v c -> c { baseVersion = v })
, ("BININSTALLPATH" , \v c -> c { binInstallDir = v })
, ("CURRYBIN" , \v c -> c { curryExec = v })
, ("HOMEPACKAGEPATH" , \v c -> c { homePackageDir = v })
, ("PACKAGEINDEXURL" , \v c -> c { packageIndexURL = v })
, ("PACKAGEINSTALLPATH" , \v c -> c { packageInstallDir = v })
, ("REPOSITORYPATH" , \v c -> c { repositoryDir = v })
[ ("APPPACKAGEPATH" , \v c -> c { appPackageDir = v })
, ("BASEVERSION" , \v c -> c { baseVersion = v })
, ("BININSTALLPATH" , \v c -> c { binInstallDir = v })
, ("CURRYBIN" , \v c -> c { curryExec = v })
, ("HOMEPACKAGEPATH" , \v c -> c { homePackageDir = v })
, ("PACKAGEINDEXURL" , \v c -> c { packageIndexURL = v })
, ("PACKAGETARFILESURL" , \v c -> c { packageTarFilesURL = v })
, ("PACKAGEINSTALLPATH" , \v c -> c { packageInstallDir = v })
, ("REPOSITORYPATH" , \v c -> c { repositoryDir = v })
]
--- Sequentially applies a list of functions that transform a value to a value
......
......@@ -59,7 +59,7 @@ cpmBanner :: String
cpmBanner = unlines [bannerLine,bannerText,bannerLine]
where
bannerText =
"Curry Package Manager <curry-language.org/tools/cpm> (version of 15/03/2019)"
"Curry Package Manager <curry-language.org/tools/cpm> (version of 24/04/2019)"
bannerLine = take (length bannerText) (repeat '-')
main :: IO ()
......
......@@ -15,7 +15,7 @@ module CPM.Package
, replaceVersionInTag
, readVersion
, packageIdEq
, showPackageSource
, showSourceOfPackage
, readVersionConstraint
, readVersionConstraints
, readPackageSpec
......@@ -347,11 +347,12 @@ packageIdEq :: Package -> Package -> Bool
packageIdEq p1 p2 = name p1 == name p2 && version p1 == version p2
--- Shows the package source in human-readable format.
showPackageSource :: Package -> String
showPackageSource pkg = case source pkg of
showSourceOfPackage :: Package -> String
showSourceOfPackage pkg = case source pkg of
Nothing -> "No source specified"
Just s -> showSource s
where
showSource :: PackageSource -> String
showSource (Git url rev) = "Git " ++ url ++ showGitRev rev
showSource (Http url) = url
showSource (FileSource url) = "File " ++ url
......
......@@ -14,6 +14,7 @@ module CPM.Package.Helpers
import Directory
import FilePath
import List ( splitOn, nub )
import System ( getPID )
import System.CurryPath ( addCurrySubdir )
import Text.Pretty hiding ( (</>) )
......@@ -59,16 +60,18 @@ installPackageSourceTo pkg (FileSource zipfile) installdir =
installPkgFromFile pkg zipfile (installdir </> packageId pkg) False
installPackageSourceTo pkg (Http url) installdir = do
let pkgDir = installdir </> packageId pkg
pid <- getPID
let pkgDir = installdir </> packageId pkg
basepf = "package" ++ show pid
revurl = reverse url
pkgfile = if take 4 revurl == "piz." then "package.zip" else
if take 7 revurl == "zg.rat." then "package.tar.gz" else ""
pkgfile = if take 4 revurl == "piz." then basepf ++ ".zip" else
if take 7 revurl == "zg.rat." then basepf ++ ".tar.gz" else ""
if null pkgfile
then failIO $ "Illegal URL (only .zip or .tar.gz allowed):\n" ++ url
else do
tmpdir <- tempDir
let tmppkgfile = tmpdir </> pkgfile
c <- inTempDir $ showExecCmd $ "curl -s -o " ++ tmppkgfile ++
c <- inTempDir $ showExecCmd $ "curl -f -s -S -o " ++ tmppkgfile ++
" " ++ quote url
if c == 0
then installPkgFromFile pkg tmppkgfile pkgDir True
......@@ -226,7 +229,7 @@ renderPackageInfo allinfos plain installed pkg = pPrint doc
src = maybe empty
(\_ -> boldText "Source" <$$>
indent 4 (text $ showPackageSource pkg))
indent 4 (text $ showSourceOfPackage pkg))
(source pkg)
srcdirs =
......
......@@ -15,6 +15,7 @@ module CPM.PackageCache.Global
, copyPackage
, installMissingDependencies
, acquireAndInstallPackage
, acquireAndInstallPackageFromSource
, tryFindPackage
, missingPackages
, installFromZip
......@@ -30,7 +31,7 @@ import List
import Maybe (isJust)
import FilePath
import CPM.Config ( Config, packageInstallDir )
import CPM.Config ( Config, packageInstallDir, packageTarFilesURL )
import CPM.ErrorLogger
import CPM.FileUtil ( copyDirectory, inTempDir, recreateDirectory, inDirectory
, removeDirectoryComplete, tempDir, whenFileExists
......@@ -109,10 +110,28 @@ copyPackage cfg pkg dir = do
where
srcDir = installedPackageDir cfg pkg
--- Acquires a package from the source specified in its specification and
--- Acquires a package, either from the global tar file repository
--- or from the source specified in its specification, and
--- installs it to the global package cache.
acquireAndInstallPackage :: Config -> Package -> IO (ErrorLogger ())
acquireAndInstallPackage cfg reppkg =
acquireAndInstallPackage cfg pkg = do
pkgDirExists <- doesDirectoryExist (installedPackageDir cfg pkg)
if pkgDirExists
then log Info $ "Package '" ++ packageId pkg ++
"' already installed, skipping"
else do
let stdurl = packageTarFilesURL cfg ++ packageId pkg ++ ".tar.gz"
infoMessage ("Installing package from " ++ stdurl)
(msgs,err) <- installPackageSourceTo pkg (Http stdurl)
(packageInstallDir cfg)
case err of
Right _ -> return (msgs,err)
Left _ -> acquireAndInstallPackageFromSource cfg pkg
--- Acquires a package from the source specified in its specification and
--- installs it to the global package cache.
acquireAndInstallPackageFromSource :: Config -> Package -> IO (ErrorLogger ())
acquireAndInstallPackageFromSource cfg reppkg =
readPackageFromRepository cfg reppkg |>= \pkg ->
case source pkg of
Nothing -> failIO $ "No source specified for " ++ packageId pkg
......@@ -128,7 +147,7 @@ installFromSource cfg pkg pkgsource = do
if pkgDirExists
then
log Info $ "Package '" ++ packageId pkg ++ "' already installed, skipping"
else log Info ("Installing package from " ++ showPackageSource pkg) |>
else log Info ("Installing package from " ++ showSourceOfPackage pkg) |>
installPackageSourceTo pkg pkgsource (packageInstallDir cfg)
where
pkgDir = installedPackageDir cfg pkg
......
......@@ -3,3 +3,7 @@ socket
This package contains the library `Network.Socket`
to support network programming with sockets.
Currently only IPv4 connections are supported
by the KICS2-Compiler (This might be the case with PAKCS too)
......@@ -2,32 +2,36 @@
--- A simple "addition" server to test the Socket library.
---
--- @author Michael Hanus
--- @version February 2006
--- @version April 2019
------------------------------------------------------------------------------
import IO
import Read(readInt)
import Read ( readInt )
import Network.Socket
-- Choose a free port number:
portnr :: Int
portnr = 32145
portnr = 65502
sendTo :: String -> String -> IO ()
sendTo host msg = do
h <- connectToSocket host portnr
hPutStr h msg
hClose h
stopServer :: String -> IO ()
stopServer host = sendTo host "TERMINATE\n"
-- An "addition" server:
addServer :: IO ()
addServer = do
socket <- listenOn portnr
putStrLn $ "Serving port: " ++ show portnr
addServeSocket socket
addServeSocket :: Socket -> IO ()
addServeSocket socket = do
(chost,stream) <- accept socket
putStrLn $ "Connection from "++chost
......
......@@ -3,46 +3,51 @@
--- on socket connections.
---
--- @author Michael Hanus
--- @version March 2006
--- @version April 2019
------------------------------------------------------------------------------
import IO
import Read(readInt)
import Read ( readInt )
import Network.Socket
-- Choose a free port number:
portnr = 32145
portnr :: Int
portnr = 65502
sendTo :: String -> String -> IO ()
sendTo host msg = do
h <- connectToSocket host portnr
hPutStr h msg
hClose h
stopServer :: String -> IO ()
stopServer host = sendTo host "TERMINATE\n"
-- An "addition" server:
addServer :: IO ()
addServer = do
socket <- listenOn portnr
putStrLn $ "Serving port: " ++ show portnr
addServeSocket socket
addServeSocket :: Socket -> IO ()
addServeSocket socket = do
conn <- waitForSocketAccept socket 1000
addServeSocketTest socket conn
addServeSocketTest :: Socket -> Maybe (String,Handle) -> IO ()
addServeSocketTest socket Nothing = do
putStrLn "Timeout"
addServeSocket socket
addServeSocketTest socket (Just (chost,stream)) = do
putStrLn $ "Connection from "++chost
serverLoop stream
where
serverLoop h = do
l1 <- hGetLine h
if l1=="TERMINATE"
if l1 == "TERMINATE"
then do hClose h
close socket
else do l2 <- hGetLine h
......@@ -50,6 +55,7 @@ addServeSocketTest socket (Just (chost,stream)) = do
hClose h
addServeSocket socket
addClient :: String -> Int -> Int -> IO ()
addClient host x y = do
h <- connectToSocket host portnr
hPutStr h (unlines (map show [x,y]))
......
......@@ -40,6 +40,7 @@ listenOnFresh external
--- the client (the format of this string is implementation-dependent)
--- and a handle to a stream communication with the client.
--- The handle is both readable and writable.
--- Only IPv4 connections are currently possible.
accept :: Socket -> IO (String,Handle)
accept s = prim_socketAccept $## s
......@@ -74,6 +75,7 @@ prim_sClose external
-- Client side operations:
--- Creates a new connection to a Unix socket.
--- Only IPv4 connections are currently possible.
--- @param host - the host name of the connection
--- @param port - the port number of the connection
--- @return the handle of the stream (connected to the port port@host)
......
......@@ -33,16 +33,19 @@ external_d_C_listenOnFresh _ _ = toCurry listenOnFreshPort
-------------------------------------------------
acceptOld :: Socket -> IO (Handle, HostName, PortNumber)
acceptOld sock = do (s, addr) <- Network.Socket.accept sock
h <- socketToHandle s ReadWriteMode
acceptOld sock = do (s, peer) <- Network.Socket.accept sock
p <- socketPort s
n <- getSocketName s
(Just hn, _) <- getNameInfo [] True False n
return (h, hn, p)
h <- socketToHandle s ReadWriteMode
-- s is invalid after this point.
return (h, show peer, p)
listenOn :: PortNumber -> IO Socket
listenOn pn = do
let hints = defaultHints { addrFlags = [AI_PASSIVE], addrSocketType = Stream }
-- AI_PASSIVE is needed when the address should be used for bind/listenOn
-- AF_INET forces IPv4. This is crucial, because some
-- systems crashed with the old Implementation that allowed IPv6
-- As soon as IPv6 is needed, someone has to look into this issue again.
let hints = defaultHints { addrFlags = [AI_PASSIVE], addrFamily = AF_INET }
addr:_ <- getAddrInfo (Just hints) Nothing (Just (show pn))
sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
setSocketOption sock ReuseAddr 1
......@@ -57,7 +60,8 @@ sClose = close
connectTo :: HostName -> PortNumber -> IO Handle
connectTo s a = do
let hints = defaultHints { addrSocketType = Stream }
-- for AF_INET see above
let hints = defaultHints { addrFamily = AF_INET }
addr:_ <- getAddrInfo (Just hints) (Just s) (Just (show a))
sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
connect sock (addrAddress addr)
......
......@@ -3,3 +3,7 @@ socket
This package contains the library `Network.Socket`
to support network programming with sockets.
Currently only IPv4 connections are supported
by the KICS2-Compiler (This might be the case with PAKCS too)
......@@ -2,32 +2,36 @@
--- A simple "addition" server to test the Socket library.
---
--- @author Michael Hanus
--- @version February 2006
--- @version April 2019
------------------------------------------------------------------------------
import IO
import Read(readInt)
import Read ( readInt )
import Network.Socket
-- Choose a free port number:
portnr :: Int
portnr = 32145
portnr = 65502
sendTo :: String -> String -> IO ()
sendTo host msg = do
h <- connectToSocket host portnr
hPutStr h msg
hClose h
stopServer :: String -> IO ()
stopServer host = sendTo host "TERMINATE\n"
-- An "addition" server:
addServer :: IO ()
addServer = do
socket <- listenOn portnr
putStrLn $ "Serving port: " ++ show portnr
addServeSocket socket
addServeSocket :: Socket -> IO ()
addServeSocket socket = do
(chost,stream) <- accept socket
putStrLn $ "Connection from "++chost
......
......@@ -3,46 +3,51 @@
--- on socket connections.
---
--- @author Michael Hanus
--- @version March 2006
--- @version April 2019
------------------------------------------------------------------------------
import IO
import Read(readInt)
import Read ( readInt )
import Network.Socket
-- Choose a free port number:
portnr = 32145
portnr :: Int
portnr = 65502
sendTo :: String -> String -> IO ()
sendTo host msg = do
h <- connectToSocket host portnr
hPutStr h msg
hClose h
stopServer :: String -> IO ()
stopServer host = sendTo host "TERMINATE\n"
-- An "addition" server:
addServer :: IO ()
addServer = do
socket <- listenOn portnr
putStrLn $ "Serving port: " ++ show portnr
addServeSocket socket
addServeSocket :: Socket -> IO ()
addServeSocket socket = do
conn <- waitForSocketAccept socket 1000
addServeSocketTest socket conn
addServeSocketTest :: Socket -> Maybe (String,Handle) -> IO ()
addServeSocketTest socket Nothing = do
putStrLn "Timeout"
addServeSocket socket
addServeSocketTest socket (Just (chost,stream)) = do
putStrLn $ "Connection from "++chost
serverLoop stream
where
serverLoop h = do
l1 <- hGetLine h
if l1=="TERMINATE"
if l1 == "TERMINATE"
then do hClose h
close socket
else do l2 <- hGetLine h
......@@ -50,6 +55,7 @@ addServeSocketTest socket (Just (chost,stream)) = do
hClose h
addServeSocket socket
addClient :: String -> Int -> Int -> IO ()
addClient host x y = do
h <- connectToSocket host portnr
hPutStr h (unlines (map show [x,y]))
......
......@@ -40,6 +40,7 @@ listenOnFresh external
--- the client (the format of this string is implementation-dependent)
--- and a handle to a stream communication with the client.
--- The handle is both readable and writable.
--- Only IPv4 connections are currently possible.
accept :: Socket -> IO (String,Handle)
accept s = prim_socketAccept $## s
......@@ -74,6 +75,7 @@ prim_sClose external
-- Client side operations:
--- Creates a new connection to a Unix socket.
--- Only IPv4 connections are currently possible.
--- @param host - the host name of the connection
--- @param port - the port number of the connection
--- @return the handle of the stream (connected to the port port@host)
......
......@@ -33,16 +33,19 @@ external_d_C_listenOnFresh _ _ = toCurry listenOnFreshPort
-------------------------------------------------
acceptOld :: Socket -> IO (Handle, HostName, PortNumber)
acceptOld sock = do (s, addr) <- Network.Socket.accept sock
h <- socketToHandle s ReadWriteMode
acceptOld sock = do (s, peer) <- Network.Socket.accept sock
p <- socketPort s
n <- getSocketName s
(Just hn, _) <- getNameInfo [] True False n
return (h, hn, p)
h <- socketToHandle s ReadWriteMode
-- s is invalid after this point.
return (h, show peer, p)
listenOn :: PortNumber -> IO Socket
listenOn pn = do
let hints = defaultHints { addrFlags = [AI_PASSIVE], addrSocketType = Stream }
-- AI_PASSIVE is needed when the address should be used for bind/listenOn
-- AF_INET forces IPv4. This is crucial, because some
-- systems crashed with the old Implementation that allowed IPv6
-- As soon as IPv6 is needed, someone has to look into this issue again.
let hints = defaultHints { addrFlags = [AI_PASSIVE], addrFamily = AF_INET }
addr:_ <- getAddrInfo (Just hints) Nothing (Just (show pn))
sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
setSocketOption sock ReuseAddr 1
......@@ -57,7 +60,8 @@ sClose = close
connectTo :: HostName -> PortNumber -> IO Handle
connectTo s a = do
let hints = defaultHints { addrSocketType = Stream }
-- for AF_INET see above
let hints = defaultHints { addrFamily = AF_INET }
addr:_ <- getAddrInfo (Just hints) (Just s) (Just (show a))
sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
connect sock (addrAddress addr)
......
Copyright (c) 2019, Michael Hanus
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are
met:
1. Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
2. Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in the
documentation and/or other materials provided with the distribution.
3. Neither the names of the copyright holders nor the names of its
contributors may be used to endorse or promote products derived from
this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
transbooleq: A tool to transform Boolean equalities into constraints
====================================================================
This package contains the implementation of a transformation tool
that replaces Boolean equalities by equational constraints
in FlatCurry programs.
The tool is integrated into the compilation chain of PAKCS/KiCS2.
The motivation and ideas of this tool are described in the following paper:
The motivation and ideas of this tool are described in the following papers:
Antoy, S., Hanus, M.: From Boolean Equalities to Constraints
Proceedings of the 25th International Symposium on Logic-based Program
Synthesis and Transformation (LOPSTR 2015), Springer LNCS 9527, 2015, 73-88
Synthesis and Transformation (LOPSTR 2015), Springer LNCS 9527, 2015, pp. 73-88
http://dx.doi.org/10.1007/978-3-319-27436-2_5
Antoy, S., Hanus, M.: Transforming Boolean equalities into constraints
Formal Aspects of Computing, 29(3), 2017, pp. 475-494
http://dx.doi.org/10.1007/s00165-016-0399-6
Statistics about the number of transformations are shown
with increased verbosity levels. For instance, if one sets the
......
......@@ -3,7 +3,7 @@
--- by equational constraints (which binds variables).
---
--- @author Michael Hanus
--- @version August 2018
--- @version April 2019
-------------------------------------------------------------------------
module BindingOpt (main, transformFlatProg) where
......@@ -23,7 +23,8 @@ import Analysis.Types
import Analysis.ProgInfo
import Analysis.RequiredValues
import CASS.Server ( analyzeGeneric, analyzePublic, analyzeInterface )
import System.CurryPath ( currySubdir, addCurrySubdir, splitModuleFileName )
import System.CurryPath ( addCurrySubdir, currySubdir
, lookupModuleSourceInLoadPath, splitModuleFileName )
import Text.CSV
......@@ -92,30 +93,34 @@ printVerbose verbosity printlevel message =
transformBoolEq :: Options -> String -> IO ()
transformBoolEq opts@(verb, _, _) name = do
let isfcyname = fileSuffix name == "fcy"
modname = if isfcyname
then modNameOfFcyName (normalise (stripSuffix name))
else name
(moddir,modname) <-
if isfcyname
then return $ modNameOfFcyName (normalise (stripSuffix name))
else lookupModuleSourceInLoadPath name >>=
maybe (error $ "Source file of module '" ++ name ++
"' not found!")
(\ (dir,_) -> return (dir,name))
printVerbose verb 1 $ "Reading and analyzing module '" ++ modname ++ "'..."
flatprog <- if isfcyname then readFlatCurryFile name
else readFlatCurry modname
transformAndStoreFlatProg opts modname flatprog
transformAndStoreFlatProg opts moddir modname flatprog
-- Drop a suffix from a list if present or leave the list as is otherwise.
dropSuffix :: Eq a => [a] -> [a] -> [a]
dropSuffix sfx s | sfx `isSuffixOf` s = take (length s - length sfx) s
| otherwise = s
-- Extracts the module name from a given FlatCurry file name:
modNameOfFcyName :: String -> String
-- Extracts the directory path and module name from a given FlatCurry file name:
modNameOfFcyName :: String -> (String,String)
modNameOfFcyName name =
let wosuffix = normalise (stripSuffix name)
[dir,wosubdir] = splitOn (currySubdir ++ [pathSeparator]) wosuffix
in -- construct hierarchical module name:
dir </> intercalate "." (split (==pathSeparator) wosubdir)
(dir, intercalate "." (split (==pathSeparator) wosubdir))
transformAndStoreFlatProg :: Options -> String -> Prog -> IO ()
transformAndStoreFlatProg opts@(verb, _, load) modname prog = do
let (dir, name) = splitModuleFileName (progName prog) modname
transformAndStoreFlatProg :: Options -> String -> String -> Prog -> IO ()
transformAndStoreFlatProg opts@(verb, _, load) dir modname prog = do
let name = intercalate [pathSeparator] (split (== '.') modname)
oldprogfile = normalise $ addCurrySubdir dir </> name <.> "fcy"
newprogfile = normalise $ addCurrySubdir dir </> name ++ "_O" <.> "fcy"
starttime <- getCPUTime
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment