Commit e395dee9 authored by Bernd Brassel's avatar Bernd Brassel
Browse files

debugger can now generate compilable prelude

parent a43d6501
......@@ -36,8 +36,8 @@ Executable kics
containers,
ghc-paths,
process,
curry-base >= 0.2.5,
curry-frontend >= 0.2.7
curry-base >= 0.2.6,
curry-frontend >= 0.2.8
Other-Modules:
Curry.Compiler.Config
Curry.Compiler.CurryToHaskell
......
{- Auto generated stubs for external functions and types
Remove this comment to suppress warnings. -}
module Curry.DebugModule.CEventOracle where
instance DI.GenTerm (Ref dm) where
genTerm x0 = Prelude.error "not implemented"
data (DM.DM dm) => Ref dm = Ref
strict_initRef ::
(DM.DM dm) => dm (Curry.DebugModule.Prelude.IO dm Ref)
strict_initRef
= hook_strict_initRef (Prelude.error "not implemented")
strict_finalize ::
(DM.DM dm) =>
Curry.DebugModule.Prelude.List Curry.DebugModule.Prelude.Char ->
dm (Curry.DebugModule.Prelude.IO dm Curry.DebugModule.Prelude.Unit)
strict_finalize x0
= hook_strict_finalize x0 (Prelude.error "not implemented")
strict_fresh ::
(DM.DM dm) => Curry.DebugModule.Prelude.Unit -> dm Ref
strict_fresh x0
= hook_strict_fresh x0 (Prelude.error "not implemented")
strict_replace :: (DM.DM dm, DI.GenTerm a) => Ref -> a -> dm a
strict_replace x0 x1
= hook_strict_replace x0 x1 (Prelude.error "not implemented")
strict_collapse :: (DM.DM dm, DI.GenTerm a) => Ref -> a -> dm a
strict_collapse x0 x1
= hook_strict_collapse x0 x1 (Prelude.error "not implemented")
strict_closeRef :: (DM.DM dm, DI.GenTerm a) => Ref -> a -> dm a
strict_closeRef x0 x1
= hook_strict_closeRef x0 x1 (Prelude.error "not implemented")
strict_expand ::
(DM.DM dm, DI.GenTerm a) =>
Ref -> Curry.DebugModule.Prelude.List Ref -> a -> dm a
strict_expand x0 x1 x2
= hook_strict_expand x0 x1 x2 (Prelude.error "not implemented")
strict_unknown :: (DM.DM dm, DI.GenTerm a) => Ref -> dm a
strict_unknown x0
= hook_strict_unknown x0 (Prelude.error "not implemented")
op_DollarEMark ::
(DM.DM dm, DI.GenTerm a, DI.GenTerm b) =>
DM.Func dm Ref (DM.Func dm a b) -> a -> Ref -> dm b
op_DollarEMark x0 x1 x2
= hook_op_DollarEMark x0 x1 x2 (Prelude.error "not implemented")
op_DollarEMarkEMark ::
(DM.DM dm, DI.GenTerm a, DI.GenTerm b) =>
DM.Func dm Ref (DM.Func dm a b) -> a -> Ref -> dm b
op_DollarEMarkEMark x0 x1 x2
= hook_op_DollarEMarkEMark x0 x1 x2
(Prelude.error "not implemented")
op_DollarRhomb ::
(DM.DM dm, DI.GenTerm a, DI.GenTerm b) =>
DM.Func dm Ref (DM.Func dm a b) -> a -> Ref -> dm b
op_DollarRhomb x0 x1 x2
= hook_op_DollarRhomb x0 x1 x2 (Prelude.error "not implemented")
op_DollarRhombRhomb ::
(DM.DM dm, DI.GenTerm a, DI.GenTerm b) =>
DM.Func dm Ref (DM.Func dm a b) -> a -> Ref -> dm b
op_DollarRhombRhomb x0 x1 x2
= hook_op_DollarRhombRhomb x0 x1 x2
(Prelude.error "not implemented")
strict_apply ::
(DM.DM dm, DI.GenTerm a, DI.GenTerm b) =>
DM.Func dm Ref (DM.Func dm a b) -> a -> Ref -> dm b
strict_apply x0 x1 x2
= hook_strict_apply x0 x1 x2 (Prelude.error "not implemented")
\ No newline at end of file
{- Auto generated stubs for external functions and types
Remove this comment to suppress warnings. -}
module Curry.DebugModule.Global where
instance DI.GenTerm (Global dm a) where
genTerm x0 = Prelude.error "not implemented"
data (DM.DM dm, DI.GenTerm a) => Global dm a = Global a
strict_global ::
(DM.DM dm, DI.GenTerm a) => a -> GlobalSpec -> dm (Global a)
strict_global x0 x1
= hook_strict_global x0 x1 (Prelude.error "not implemented")
strict_prim_readGlobal ::
(DM.DM dm, DI.GenTerm a) =>
Global a -> dm (Curry.DebugModule.Prelude.IO dm a)
strict_prim_readGlobal x0
= hook_strict_prim_readGlobal x0 (Prelude.error "not implemented")
strict_prim_writeGlobal ::
(DM.DM dm, DI.GenTerm a) =>
Global a ->
a ->
dm (Curry.DebugModule.Prelude.IO dm Curry.DebugModule.Prelude.Unit)
strict_prim_writeGlobal x0 x1
= hook_strict_prim_writeGlobal x0 x1
(Prelude.error "not implemented")
\ No newline at end of file
{- Auto generated stubs for external functions and types
Remove this comment to suppress warnings. -}
module Curry.DebugModule.IO where
instance DI.GenTerm (Handle dm) where
genTerm x0 = Prelude.error "not implemented"
data (DM.DM dm) => Handle dm = Handle
strict_stdin :: (DM.DM dm) => dm Handle
strict_stdin = hook_strict_stdin (Prelude.error "not implemented")
strict_stdout :: (DM.DM dm) => dm Handle
strict_stdout
= hook_strict_stdout (Prelude.error "not implemented")
strict_stderr :: (DM.DM dm) => dm Handle
strict_stderr
= hook_strict_stderr (Prelude.error "not implemented")
strict_prim_openFile ::
(DM.DM dm) =>
Curry.DebugModule.Prelude.List Curry.DebugModule.Prelude.Char ->
IOMode -> dm (Curry.DebugModule.Prelude.IO dm Handle)
strict_prim_openFile x0 x1
= hook_strict_prim_openFile x0 x1 (Prelude.error "not implemented")
strict_prim_hClose ::
(DM.DM dm) =>
Handle ->
dm (Curry.DebugModule.Prelude.IO dm Curry.DebugModule.Prelude.Unit)
strict_prim_hClose x0
= hook_strict_prim_hClose x0 (Prelude.error "not implemented")
strict_prim_hFlush ::
(DM.DM dm) =>
Handle ->
dm (Curry.DebugModule.Prelude.IO dm Curry.DebugModule.Prelude.Unit)
strict_prim_hFlush x0
= hook_strict_prim_hFlush x0 (Prelude.error "not implemented")
strict_prim_hIsEOF ::
(DM.DM dm) =>
Handle ->
dm (Curry.DebugModule.Prelude.IO dm Curry.DebugModule.Prelude.Bool)
strict_prim_hIsEOF x0
= hook_strict_prim_hIsEOF x0 (Prelude.error "not implemented")
strict_prim_hSeek ::
(DM.DM dm) =>
Handle ->
SeekMode ->
Curry.DebugModule.Prelude.Int ->
dm (Curry.DebugModule.Prelude.IO dm Curry.DebugModule.Prelude.Unit)
strict_prim_hSeek x0 x1 x2
= hook_strict_prim_hSeek x0 x1 x2 (Prelude.error "not implemented")
strict_prim_hWaitForInput ::
(DM.DM dm) =>
Handle ->
Curry.DebugModule.Prelude.Int ->
dm (Curry.DebugModule.Prelude.IO dm Curry.DebugModule.Prelude.Bool)
strict_prim_hWaitForInput x0 x1
= hook_strict_prim_hWaitForInput x0 x1
(Prelude.error "not implemented")
strict_prim_hWaitForInputs ::
(DM.DM dm) =>
Curry.DebugModule.Prelude.List Handle ->
Curry.DebugModule.Prelude.Int ->
dm (Curry.DebugModule.Prelude.IO dm Curry.DebugModule.Prelude.Int)
strict_prim_hWaitForInputs x0 x1
= hook_strict_prim_hWaitForInputs x0 x1
(Prelude.error "not implemented")
strict_prim_hGetChar ::
(DM.DM dm) =>
Handle ->
dm (Curry.DebugModule.Prelude.IO dm Curry.DebugModule.Prelude.Char)
strict_prim_hGetChar x0
= hook_strict_prim_hGetChar x0 (Prelude.error "not implemented")
strict_prim_hPutChar ::
(DM.DM dm) =>
Handle ->
Curry.DebugModule.Prelude.Char ->
dm (Curry.DebugModule.Prelude.IO dm Curry.DebugModule.Prelude.Unit)
strict_prim_hPutChar x0 x1
= hook_strict_prim_hPutChar x0 x1 (Prelude.error "not implemented")
strict_prim_hIsReadable ::
(DM.DM dm) =>
Handle ->
dm (Curry.DebugModule.Prelude.IO dm Curry.DebugModule.Prelude.Bool)
strict_prim_hIsReadable x0
= hook_strict_prim_hIsReadable x0 (Prelude.error "not implemented")
strict_prim_hIsWritable ::
(DM.DM dm) =>
Handle ->
dm (Curry.DebugModule.Prelude.IO dm Curry.DebugModule.Prelude.Bool)
strict_prim_hIsWritable x0
= hook_strict_prim_hIsWritable x0 (Prelude.error "not implemented")
\ No newline at end of file
{- Auto generated stubs for external functions and types
Remove this comment to suppress warnings. -}
module Curry.DebugModule.IOExts where
instance DI.GenTerm (IORef dm a) where
genTerm x0 = Prelude.error "not implemented"
data (DM.DM dm, DI.GenTerm a) => IORef dm a = IORef a
strict_prim_execCmd ::
(DM.DM dm) =>
Curry.DebugModule.Prelude.List Curry.DebugModule.Prelude.Char ->
dm
(Curry.DebugModule.Prelude.IO dm
(Curry.DebugModule.Prelude.Tuple3 Curry.DebugModule.IO.Handle
Curry.DebugModule.IO.Handle
Curry.DebugModule.IO.Handle))
strict_prim_execCmd x0
= hook_strict_prim_execCmd x0 (Prelude.error "not implemented")
strict_prim_connectToCmd ::
(DM.DM dm) =>
Curry.DebugModule.Prelude.List Curry.DebugModule.Prelude.Char ->
dm (Curry.DebugModule.Prelude.IO dm Curry.DebugModule.IO.Handle)
strict_prim_connectToCmd x0
= hook_strict_prim_connectToCmd x0
(Prelude.error "not implemented")
strict_prim_setAssoc ::
(DM.DM dm) =>
Curry.DebugModule.Prelude.List Curry.DebugModule.Prelude.Char ->
Curry.DebugModule.Prelude.List Curry.DebugModule.Prelude.Char ->
dm (Curry.DebugModule.Prelude.IO dm Curry.DebugModule.Prelude.Unit)
strict_prim_setAssoc x0 x1
= hook_strict_prim_setAssoc x0 x1 (Prelude.error "not implemented")
strict_prim_getAssoc ::
(DM.DM dm) =>
Curry.DebugModule.Prelude.List Curry.DebugModule.Prelude.Char ->
dm
(Curry.DebugModule.Prelude.IO dm
(Curry.DebugModule.Prelude.Maybe
(Curry.DebugModule.Prelude.List Curry.DebugModule.Prelude.Char)))
strict_prim_getAssoc x0
= hook_strict_prim_getAssoc x0 (Prelude.error "not implemented")
strict_newIORef ::
(DM.DM dm, DI.GenTerm a) =>
a -> dm (Curry.DebugModule.Prelude.IO dm (IORef a))
strict_newIORef x0
= hook_strict_newIORef x0 (Prelude.error "not implemented")
strict_prim_readIORef ::
(DM.DM dm, DI.GenTerm a) =>
IORef a -> dm (Curry.DebugModule.Prelude.IO dm a)
strict_prim_readIORef x0
= hook_strict_prim_readIORef x0 (Prelude.error "not implemented")
strict_prim_writeIORef ::
(DM.DM dm, DI.GenTerm a) =>
IORef a ->
a ->
dm (Curry.DebugModule.Prelude.IO dm Curry.DebugModule.Prelude.Unit)
strict_prim_writeIORef x0 x1
= hook_strict_prim_writeIORef x0 x1
(Prelude.error "not implemented")
\ No newline at end of file
{- Auto generated stubs for external functions and types
Remove this comment to suppress warnings. -}
module Curry.DebugModule.System where
strict_getCPUTime ::
(DM.DM dm) =>
dm (Curry.DebugModule.Prelude.IO dm Curry.DebugModule.Prelude.Int)
strict_getCPUTime
= hook_strict_getCPUTime (Prelude.error "not implemented")
strict_getElapsedTime ::
(DM.DM dm) =>
dm (Curry.DebugModule.Prelude.IO dm Curry.DebugModule.Prelude.Int)
strict_getElapsedTime
= hook_strict_getElapsedTime (Prelude.error "not implemented")
strict_getArgs ::
(DM.DM dm) =>
dm
(Curry.DebugModule.Prelude.IO dm
(Curry.DebugModule.Prelude.List
(Curry.DebugModule.Prelude.List Curry.DebugModule.Prelude.Char)))
strict_getArgs
= hook_strict_getArgs (Prelude.error "not implemented")
strict_prim_getEnviron ::
(DM.DM dm) =>
Curry.DebugModule.Prelude.List Curry.DebugModule.Prelude.Char ->
dm
(Curry.DebugModule.Prelude.IO dm
(Curry.DebugModule.Prelude.List Curry.DebugModule.Prelude.Char))
strict_prim_getEnviron x0
= hook_strict_prim_getEnviron x0 (Prelude.error "not implemented")
strict_getHostname ::
(DM.DM dm) =>
dm
(Curry.DebugModule.Prelude.IO dm
(Curry.DebugModule.Prelude.List Curry.DebugModule.Prelude.Char))
strict_getHostname
= hook_strict_getHostname (Prelude.error "not implemented")
strict_getPID ::
(DM.DM dm) =>
dm (Curry.DebugModule.Prelude.IO dm Curry.DebugModule.Prelude.Int)
strict_getPID
= hook_strict_getPID (Prelude.error "not implemented")
strict_getProgName ::
(DM.DM dm) =>
dm
(Curry.DebugModule.Prelude.IO dm
(Curry.DebugModule.Prelude.List Curry.DebugModule.Prelude.Char))
strict_getProgName
= hook_strict_getProgName (Prelude.error "not implemented")
strict_prim_system ::
(DM.DM dm) =>
Curry.DebugModule.Prelude.List Curry.DebugModule.Prelude.Char ->
dm (Curry.DebugModule.Prelude.IO dm Curry.DebugModule.Prelude.Int)
strict_prim_system x0
= hook_strict_prim_system x0 (Prelude.error "not implemented")
strict_prim_exitWith ::
(DM.DM dm, DI.GenTerm a) =>
Curry.DebugModule.Prelude.Int ->
dm (Curry.DebugModule.Prelude.IO dm a)
strict_prim_exitWith x0
= hook_strict_prim_exitWith x0 (Prelude.error "not implemented")
strict_prim_sleep ::
(DM.DM dm) =>
Curry.DebugModule.Prelude.Int ->
dm (Curry.DebugModule.Prelude.IO dm Curry.DebugModule.Prelude.Unit)
strict_prim_sleep x0
= hook_strict_prim_sleep x0 (Prelude.error "not implemented")
\ No newline at end of file
......@@ -11,26 +11,48 @@ build-type: Custom
Synopsis: debug features for kics
Description: This package contains the debugger for the Curry to Haskell compiler "kics".
Stability: experimental
extra-source-files:
Curry/Module/*.hs.include
Data-Dir: prophecy/Curry/Module/.curry
Data-Files: *.fcy
*.fint
extra-tmp-files:
Curry/Module
extra-source-files:
oracle/Curry/Module/*.hs.include
biosphere/src/Curry/Module/TransformationPrint.hs.include
Data-Files:
prophecy/Curry/Module/.curry/*.fcy
prophecy/Curry/Module/.curry/*.fint
biosphere/src/Curry/Module/.curry/*.fcy
biosphere/src/Curry/Module/.curry/*.fint
Library
hs-source-dirs: oracle
hs-source-dirs: .,oracle,biosphere/src
Build-Depends:
base == 4.1.*,
KiCS >= 0.9.0
haskell98,
filepath,
syb,
containers,
mtl,
KiCS >= 0.9.1
Exposed-Modules:
Curry.Module.CEventOracle
Curry.Module.EventOracle
Curry.Files.KiCSDebugPath
Curry.Module.Oracle
Curry.Debugger.DebugMonad
Curry.Debugger.DebugInfo
Curry.Debugger.PartCalls
Other-Modules:
Curry.Module.EventOracle
Curry.Module.CEventOracle
Curry.Debugger.Logic
Curry.Debugger.BoolStack
Curry.Debugger.Oracle
Paths_KiCS_debugger
install-includes: oracle/coracle.h
c-sources: oracle/coracle.c
Executable prophecy
main-is: Main.hs
main-is: prophecy.hs
hs-source-dirs: prophecy, .curry/kics
Build-Depends:
base == 4.1.*,
......@@ -41,3 +63,30 @@ Executable prophecy
Curry.Module.LiftCases
Curry.Module.Make
Curry.Module.Transform
Executable mkstrict
main-is: mkstrict.hs
hs-source-dirs: prophecy, biosphere/src, .curry/kics
Build-Depends:
base == 4.1.*,
haskell-src,
curry-base >= 0.2.6,
KiCS >= 0.9.0
Other-Modules:
Curry.Module.LiftCases
Curry.Module.Make
Curry.Module.SrcRef
Curry.Module.AbstractHaskell
Curry.Module.FlatToAbstractCurry
Curry.Module.TransformationDebugInfo
Curry.Module.TransformationMonad
Curry.Module.TransformationPrint
Curry.Module.TransformationPartCalls
Curry.Module.TransformationComb
Curry.Module.TransformationExpr
Curry.Module.TransformationInstances
Curry.Module.TransformationSignatures
Curry.Module.ExternalStubs
Curry.Module.Transformation
Curry.Module.TransformationDependencies
module Main where
import System.FilePath
import System.Directory
import Monad
import Data.List
import Distribution.Simple
import Distribution.Simple.Setup as SS
import Distribution.Simple.Setup
import Distribution.Simple.Program
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.PreProcess
import Distribution.PackageDescription
import Distribution.Verbosity
import Distribution.ModuleName (ModuleName(..))
import Curry.Files.CymakePath
import Curry.Files.KiCSPath
kics :: IO Program
kics = mkProg getKiCS
cymake :: IO Program
kics, cymake :: IO Program
kics = mkProg getKiCS
cymake = mkProg getCymake
mkProg getProg = do
......@@ -25,23 +26,55 @@ mkProg getProg = do
return (simpleProgram (takeBaseName call))
{programFindLocation = \_-> return (Just call)}
prophecy, mkstrict :: Program
prophecy = simpleProgram "prophecy"
mkstrict = simpleProgram "mkstrict"
main :: IO ()
main = do
cymakeProg <- cymake
kicsProg <- kics
defaultMainWithHooks simpleUserHooks
{hookedPrograms=kicsProg:cymakeProg:hookedPrograms simpleUserHooks
{hookedPrograms=kicsProg:cymakeProg:prophecy:hookedPrograms simpleUserHooks
,confHook=myConfHook
,postConf=myPostConf
,hookedPreProcessors=[("curry",mkModule)]
,hookedPreProcessors=[("curry",mkModule),("lcurry",mkModule)]
}
-- what a hack! something was forgotten in Distribution.ModuleName
modName :: [String] -> ModuleName
modName xs = read $ "ModuleName " ++ show xs
myConfHook :: (Either GenericPackageDescription PackageDescription, HookedBuildInfo)
-> ConfigFlags
-> IO LocalBuildInfo
myConfHook info flags = do
lbi <- confHook simpleUserHooks info flags
libPath <- getKiCSLibDir
allFiles <- getDirectoryContents libPath
let stdlibs = map takeBaseName (filter (isSuffixOf ".fcy") allFiles)
libs = concatMap
(\ lib -> [--modName ("Curry":"Module":["Oracle" ++ lib])
{- , -}modName ("Curry":"DebugModule":[lib])])
stdlibs
package = localPkgDescr lbi
Just lib = library package
lib' = Just lib{exposedModules=exposedModules lib ++ libs}
let require p = requireProg flags lbi (return p)
prop <- require prophecy
stri <- require mkstrict
mapM (mkOracleLib (unflag $ configVerbosity flags) prop stri) stdlibs
return lbi{localPkgDescr=package{library=lib'}}
unflag = fromFlagOrDefault silent
requireProg :: SS.Flag Verbosity -> LocalBuildInfo -> IO Program -> IO ()
requireProg :: ConfigFlags -> LocalBuildInfo -> IO Program
-> IO ConfiguredProgram
requireProg verb lbi prog = do
p <- prog
requireProgram (unflag verb) p AnyVersion (withPrograms lbi)
return ()
(cp,_) <- requireProgram (unflag $ configVerbosity verb) p AnyVersion
(withPrograms lbi)
return cp
callProg :: Verbosity -> LocalBuildInfo -> IO Program -> Args -> IO ()
callProg verb lbi prog args = do
......@@ -50,11 +83,18 @@ callProg verb lbi prog args = do
myPostConf :: Args -> ConfigFlags -> PackageDescription -> LocalBuildInfo -> IO ()
myPostConf args confFlags descrs lbi = do
let require = requireProg (configVerbosity confFlags) lbi
let require = requireProg confFlags lbi
require cymake
require kics
postConf simpleUserHooks args confFlags descrs lbi
mkOracleLib :: Verbosity -> ConfiguredProgram -> ConfiguredProgram -> FilePath -> IO ()
mkOracleLib verb prop strict stdlib = do
rawSystemProgram verb prop ["-o","Curry/Module/",stdlib]
when (not (elem stdlib []))
(rawSystemProgram verb strict ["-o","Curry/DebugModule/",stdlib])
return ()
mkModule :: BuildInfo -> LocalBuildInfo -> PreProcessor
mkModule buildInfo lbi = PreProcessor
{platformIndependent = True
......@@ -64,12 +104,14 @@ runKics :: LocalBuildInfo -> FilePath -> FilePath -> Verbosity -> IO ()
runKics lbi infile outfile verb = do
let call = callProg verb lbi
datadir <- getKiCSLibDir
mapM (\ format -> call cymake ["-e",'-':'-':format,"-i"++datadir,"-iprophecy/Curry/Module",infile])
["flat"]
if not (isSuffixOf "Transform.curry" infile)
then call kics ["-nomake","-o",outfile,infile]
else call kics ["-v","3","-nomake","-executable","prophecy","-o",outfile,infile]
call cymake ["-e","--flat","-i"++datadir
,"-iprophecy/Curry/Module"
,"-ibiosphere/src/Curry/Module"
,infile]
let callKics = call kics . (["-nomake","-userlibpath","prophecy/Curry/Module","-o",outfile]++)
if isSuffixOf "Transform.curry" infile
then callKics ["-executable","prophecy",infile] else
if isSuffixOf "TransformationDependencies.lcurry" infile
then callKics ["-executable","mkstrict",infile]
else callKics [infile]
......@@ -9,17 +9,21 @@ module Make (
ModuleName,
Path,
FileName,
make, obsolete, unless) where
make, obsolete, unless,
parseArgs,Parameter,
quiet,force,modulename,output) where
import FlatCurry
import FlatCurryGoodies (progImports)
import Distribution
import Distribution as D
import FiniteMap
import IOExts
import Sort (leqString)
import FileGoodies (dirName)
import Time
import Directory
import System (getArgs)
type ModuleName = String
type Path = String
......@@ -30,13 +34,64 @@ type ProgAct a = Path -> [a] -> Prog -> IO a
type Done a = IORef (FM String a)
data Parameter = Parameter Bool Bool (Maybe String) String
defaults :: Parameter
defaults = Parameter False False Nothing ""