Commit 5414d03a authored by Bernd Brassel's avatar Bernd Brassel
Browse files

mkstrict called correctly from kicsi

parent 8ba3acc4
......@@ -11,7 +11,7 @@ build-type: Custom
Synopsis: debug features for kics
Description: This package contains the debugger for the Curry to Haskell compiler "kics".
Stability: experimental
extra-tmp-files: Curry/Module/Oracle*.f*
extra-tmp-files: Curry/Module/Oracle*.f*, Curry/Module/.curry
extra-source-files:
Curry/Module/*.hs.include
biosphere/src/Curry/Module/*.hs.include
......@@ -36,17 +36,33 @@ Library
Exposed-Modules:
Curry.Files.KiCSDebugPath
Curry.Module.Oracle
Curry.Module.CEventOracle
Curry.Debugger.DebugMonad
Curry.Debugger.DebugInfo
Curry.Debugger.PartCalls
Curry.Debugger.Tools.Debug.Monad
Curry.Debugger.Tools.Cycle.Monad
Curry.Debugger.Tools.Observations.Monad
Curry.Debugger.Tools.Tracer.Monad
Curry.Debugger.Tools.DeclarativeDebugger.CallStack
Curry.Debugger.Tools.DeclarativeDebugger.Monad
Curry.Debugger.Tools.StrictEvaluation.Monad
Curry.Debugger.Tools.Observe.Monad
Other-Modules:
Curry.Module.EventOracle
Curry.Module.CEventOracle
Curry.Debugger.Logic
Curry.Debugger.BoolStack
Curry.Debugger.Oracle
Curry.Debugger.Tools.DeclarativeDebugger.UI
Curry.Debugger.Tools.DeclarativeDebugger.Ratings
Paths_KiCS_debugger
install-includes: coracle/coracle.h
......@@ -74,6 +90,7 @@ Executable mkstrict
Build-Depends:
base == 4.1.*,
haskell-src,
directory,
curry-base >= 0.2.6,
KiCS >= 0.9.0
Other-Modules:
......
......@@ -53,9 +53,9 @@ myConfHook info flags = do
libPath <- getKiCSLibDir
allFiles <- getDirectoryContents (libPath </> ".curry")
let stdlibs = map takeBaseName (filter (isSuffixOf ".fcy") allFiles)
libs = []--map (\ l -> modName ("Curry":"Module":["Oracle" ++ l])) stdlibs
-- ++map (\ l -> modName ("Curry":"DebugModule":[l]))
-- (filter (not . (`elem` badlibs)) stdlibs)
libs = map (\ l -> modName ("Curry":"Module":["Oracle" ++ l])) stdlibs
++map (\ l -> modName ("Curry":"DebugModule":[l]))
(filter (not . (`elem` badlibs)) stdlibs)
package = localPkgDescr lbi
Just lib = library package
lib' = Just lib{exposedModules=exposedModules lib ++ libs}
......@@ -144,7 +144,7 @@ mkOracleLib :: Verbosity -> ConfiguredProgram -> ConfiguredProgram -> FilePath -
mkOracleLib verb prop strict stdlib = do
rawSystemProgram verb prop ["-o","Curry/Module/",stdlib]
when (not (elem stdlib badlibs))
(rawSystemProgram verb strict ["-o","Curry/DebugModule/",stdlib])
(rawSystemProgram verb strict ["-o","./",stdlib])
return ()
mkModule :: BuildInfo -> LocalBuildInfo -> PreProcessor
......
module DebuggerPath (
getDebugLoadPath,
getDebugFrontendParams,
getDebugLibPath) where
import Distribution
import FileGoodies
debuggerLibPath :: IO String
debuggerLibPath external
getDebugLibPath :: IO String
getDebugLibPath = do
path <- debuggerLibPath
return (path ++ [separatorChar])
getDebugLoadPath :: IO [String]
getDebugLoadPath = do
loadPath <- getLoadPath
libPath <- debuggerLibPath
return (loadPath ++ [libPath ++ [pathSeparatorChar]])
libPath <- getDebugLibPath
return (loadPath ++ [libPath])
getFrontendParams :: IO FrontendParams
getFrontendParams = do
getDebugFrontendParams :: IO FrontendParams
getDebugFrontendParams = do
loadPath <- getDebugLoadPath
return (setFullPath loadPath defaultParams)
\ No newline at end of file
......@@ -17,23 +17,18 @@ import ReadShowTerm
import FlatCurry
import FlatCurryGoodies
import DebuggerPath
import Wrapper
import Make
import AddWorld (addWorld)
import LiftCases (liftCases)
main :: IO ()
main = do
putStrLn "this is the curry prophecy generator"
params <- parseArgs
libdir <- getStdLibDir
dbgdir <- debuggerLibPath
maybe done mayCreateDirectory (output params)
print dbgdir
transform libdir dbgdir (force params) (quiet params) (output params) (modulename params)
transform libdir (force params) (quiet params) (output params) (modulename params)
putStrLn "curry prophecy generator finished"
mayCreateDirectory :: String -> IO ()
......@@ -41,8 +36,8 @@ mayCreateDirectory dir = do
ex <- doesDirectoryExist dir
unless ex (createDirectory dir)
transform :: String -> String -> Bool -> Bool -> Maybe String -> String -> IO ()
transform libdir dbgdir force quiet outdir mod = make quiet mod tester (writeTrans outdir)
transform :: String -> Bool -> Bool -> Maybe String -> String -> IO ()
transform libdir force quiet outdir mod = make quiet mod tester (writeTrans outdir)
where
tester = if force then (\ fn _ -> readTypes [fn] >>= return . Just)
else myObsolete
......@@ -55,10 +50,13 @@ transform libdir dbgdir force quiet outdir mod = make quiet mod tester (writeTra
obso = obsolete quiet (\ dir -> addFcy . addOrc dir outdir) [addFcy] readTypes
myObsolete path modu = do
ob1 <- obso path modu
if (isJust ob1 || not (isPrefixOf libdir path))
then return ob1
else obso dbgdir modu
ob <- obso path modu
if isJust ob || not (isPrefixOf libdir path)
then return ob
else do
unless quiet (putStrLn (modu ++ " is a standard library"))
ts <- readTypes [path++addFcy modu]
return (Just ts)
writeTrans :: Maybe String -> String -> [[TypeDecl]] -> Prog -> IO [TypeDecl]
writeTrans outdir path imps prog = do
......
......@@ -5,7 +5,6 @@ module Curry.Compiler.Config (
import System.FilePath
import System.Process
import System.Time (ClockTime)
import System.Process (readProcess)
import Char
import System.Environment (getEnvironment,getArgs)
import System.Directory hiding (executable)
......@@ -254,19 +253,6 @@ ghcCall opts@Opts{filename=fn} =
path -> " -i"++show (addKicsSubdir path)++" "
stricthsCall opts =
callnorm ("stricths --hs "
++ ("-s"++mainModule opts++" ")
++ (if make opts then "-m " else "")
++ (if force opts then "-f " else "")
++ (if verbosity opts < 2 then "-q " else "")
++ filename opts)
mkStrictCall opts@Opts{debugOptions=Right DebugOptions{bioTransformation=p}} =
callnorm (p
++ (if verbosity opts < 2 then "--quiet " else "")
++ filename opts)
cyCall opts = callnorm $ frontend opts++" -e " ++
unwords (map (("-i"++) . show) (libpath opts))
......@@ -277,14 +263,30 @@ cymake opts = do
(cyCall opts ++ show (filename opts)
++ if verbosity opts >= 3 then "" else " 1>/dev/null ")
prophecy opts@Opts{debugOptions=Right DebugOptions{oracleTransformation=p}} =
safeSystem (verbosity opts >= 4) $
p
++ (if force opts then " -f " else " ")
++ (if verbosity opts < 2 then " -q " else " ")
++ show (dropExtension $ filename opts)
++ if verbosity opts >= 4 then "" else " 1>/dev/null "
runCurryCmd :: String -> Options -> Safe IO ()
runCurryCmd cmd opts = do
let args = ((if force opts then ("-f":) else id) $
(if verbosity opts < 2 then ("-q":) else id)
[dropExtension $ filename opts])
put 5 opts (cmd ++ " " ++ show args)
safeIO $ do
hdle <- runProcess cmd
args
Nothing
(Just [("CURRYPATH",cmdLibpath opts)])
Nothing
Nothing
Nothing
waitForProcess hdle
return ()
prophecy opts@Opts{debugOptions=Right dbg} = do
put 5 opts "calling prophecy"
runCurryCmd (oracleTransformation dbg) opts
mkstrict opts@Opts{debugOptions=Right dbg} = do
put 5 opts "calling mkstrict"
runCurryCmd (bioTransformation dbg) opts
readConfig = do
home <- getEnv "HOME"
......@@ -411,7 +413,7 @@ safeReadFlat opts s = do
mprog <- safeIO $ readFlat fn
maybe (fail $ "file not found: "++fn) return mprog
warning fn path [] = fail ("module "++fn++" not found in path "++path)
warning fn path [] = fail ("error: file "++fn++" not found in path "++path)
warning _ _ (f:fs) = do
mapM_ (safeIO . putStrLn)
(map (\f' -> "further file found (but ignored) "++f'
......
......@@ -44,7 +44,11 @@ compilations (f:fs) opts =
compilations fs . maybe opts id
startCompilation :: Options -> Safe IO Options
startCompilation opts = do
startCompilation opts0@Opts{filename=fn,userlibpath=up} = do
let (dir,file) = splitFileName fn
opts=if null dir
then opts0{filename=file}
else opts0{filename=file,userlibpath=dir:up}
newOpts <- callFrontend opts
visited <- compile newOpts >>= return . done
when (make opts) $ do
......@@ -88,7 +92,7 @@ skip opts = do
then replaceExtension (filename opts) ".fcy"
else replaceExtension (filename opts) ".fint"
fn <- safeIO (findFileInPath fname (libpath opts)) >>=
warning (filename opts) (cmdLibpath opts)
warning fname (cmdLibpath opts)
cont <- safeIOSeq (readModule fn)
let [("Prog",rest)] = lex cont
[(name,rest')] = reads rest
......@@ -116,14 +120,15 @@ callFrontend opts@(Opts{filename=givenFile}) = do
else return foundCurry
when (make opts) $ do
unless (null foundSources) $ do
put 2 opts "calling frontend"
put 2 opts ("calling frontend for " ++ head foundSources)
if debug opts then prophecy opts else cymake opts
return (if debug opts then opts{filename=dbgModName givenFile} else opts)
getFlatCurryFileName opts@(Opts{filename=basename}) = do
let lib = libpath opts
foundFiles <- safeIO (findFileInPath (replaceExtension basename ".fcy") lib)
foundFile <- warning basename (toPathList lib) foundFiles
fn = replaceExtension basename ".fcy"
foundFiles <- safeIO (findFileInPath fn lib)
foundFile <- warning fn (toPathList lib) foundFiles
let foundBasename = dropExtensions foundFile
return (opts{filename=foundBasename})
......
......@@ -59,7 +59,7 @@ externalSpecName s = replaceExtension s ".hs.include"
dbgMName = "Oracle"
dbgModName = insertName dbgMName
strictPrefix = "S"
strictPrefix = "Curry.DebugModule."
mkStrictName = insertName strictPrefix
......
......@@ -284,7 +284,8 @@ requestExpr state opts line = do
--safeSystem (verbosity opts >= 5)
-- ("rm -f request Request.fcy "++reqMod ++".o ")
requestFile <- genReqModule (loadedFiles state) line
let compileOpts = (opts{binary=Just "request",filename=requestFile,
let compileOpts = (opts{binary=Just "request",
filename=requestFile,
mainFunc=mainExpr,
mainModule = mainMod,
make=True})
......@@ -298,9 +299,9 @@ requestExpr state opts line = do
(put 1 opts ("starting evaluation of "++line))
safeSystem (verbosity opts >= 3) call
when (debug opts) $ do
safeSystem (verbosity opts >= 5)
(mkStrictCall compileOpts{filename=inKicsSubdir reqModuleName,
make=True})
mkstrict compileOpts{filename=reqModuleName,
make=True,
userlibpath=inKicsSubdir ".":userlibpath compileOpts}
genDebugModule opts{mainModule=mainMod} (loadedFiles state) line
safeSystem (verbosity opts >= 5)
(ghcCall $ debugOff opts{target=Just (inKicsSubdir "debug"),
......@@ -358,8 +359,8 @@ imports = concatMap ("\nimport "++)
debugModuleName = "debug.hs"
genDebugModule Opts{debugOptions=Right DebugOptions{debugtool=tool},mainModule=mod} fs line = do
let filename = destination False Nothing debugModuleName
modImports = imports $ "Debugger.DebugMonad":
("Debugger.Tools."++tool++"."++"Monad"):
modImports = imports $ "Curry.Debugger.DebugMonad":
("Curry.Debugger.Tools."++tool++"."++"Monad"):
map mkStrictName ((reqModuleName++" as S"):fs)
modCont = modImports ++
"\n\nmain = do\n\
......
......@@ -123,7 +123,7 @@ currySubdir = ".curry"
inCurrySubdir :: String -> String
inCurrySubdir filename =
let (base,file) = splitDirectoryBaseName filename
in base++'/':currySubdir++'/':file
in (case base of "." -> ""; _ -> base ++ ['/'])++currySubdir++'/':file
--- Transforms a directory name into the name of the corresponding
--- sub directory containing auxiliary files.
......
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