Commit 72029483 authored by Michael Hanus 's avatar Michael Hanus
Browse files

Consistency with current PAKCS/KiCS2 system libraries improved

parent bac1c8ef
......@@ -31,10 +31,13 @@ import Time
-- Distributed Curry! If this port is occupied by another process
-- on a host, you cannot run Distributed Curry on it.)
cpnsSocket = 8767 -- standard port number of CPNS demon
-- The standard port number of CPNS demon.
cpnsSocket :: Int
cpnsSocket = 8767
-- The time out before considering the server as unreachable:
cpnsTimeOut :: Int
cpnsTimeOut = 3000
--- Type of messages to be processed by the Curry Port Name Server.
......@@ -59,6 +62,7 @@ data CPNSMessage = Terminate
| ShowRegistry
-- The lock file to coordinate the startup of the CPNS demon:
cpnsStartupLockfile :: String
cpnsStartupLockfile = "/tmp/CurryPNSD.lock"
--- Starts the "Curry Port Name Server" (CPNS) running on the local machine.
......@@ -138,6 +142,8 @@ cpnsServer regs socket = do
cpnsServer newregs socket )
msg
tryRegisterPortName :: [(String,Int,Int,Int)] -> String -> Int -> Int -> Int
-> IO (Bool, [(String, Int, Int, Int)])
tryRegisterPortName regs name pid sn pn = do
let nameregs = filter (\(n,_,_,_)->name==n) regs
ack <- if null nameregs
......@@ -157,6 +163,8 @@ tryRegisterPortName regs name pid sn pn = do
return (ack, newregs)
-- Delete all registrations for a given port name:
unregisterPortName :: [(String,Int,Int,Int)] -> String
-> IO [(String,Int,Int,Int)]
unregisterPortName regs name = do
ctime <- getLocalTime
putStrLn $ "Unregister port \""++name++"\" at "++calendarTimeToString ctime
......@@ -237,9 +245,11 @@ sendToLocalCPNS msg = doIfAlive "localhost" $ do
hClose h
--- Shows all registered ports at the local CPNS demon (in its logfile).
cpnsShow :: IO ()
cpnsShow = sendToLocalCPNS ShowRegistry
--- Terminates the local CPNS demon
cpnsStop :: IO ()
cpnsStop = sendToLocalCPNS Terminate
--- Gets an answer from a Curry port name server on a host,
......@@ -300,6 +310,7 @@ startCPNSDIfNecessary = do
done
--- Main function for CPNS demon. Check arguments and execute command.
main :: IO ()
main = do
args <- getArgs
case args of
......
......@@ -11,7 +11,7 @@
--- in order to support a more portable standard prelude.
---
--- @author Michael Hanus
--- @version July 2015
--- @version July 2018
--- @category general
------------------------------------------------------------------------------
{-# LANGUAGE CPP #-}
......@@ -21,6 +21,7 @@ module Findall
( getAllValues, getSomeValue
, allValues, someValue
, allSolutions, someSolution
, isFail
#ifdef __PAKCS__
, try, inject, solveAll, once, best
, findall, findfirst, browse, browseList, unpack
......@@ -115,6 +116,16 @@ someSolution p = findfirst (\x -> p x =:= True)
someSolution p = someValue (let x free in p x &> x)
#endif
--- Does the computation of the argument to a head-normal form fail?
--- Conceptually, the argument is evaluated on a copy, i.e.,
--- even if the computation does not fail, it has not been evaluated.
isFail :: a -> Bool
#ifdef __PAKCS__
isFail external
#else
isFail x = null (allValues (x `seq` ()))
#endif
#ifdef __PAKCS__
------------------------------------------------------------------------------
--- Basic search control operator.
......
......@@ -9,6 +9,10 @@
<library>prim_standard</library>
<entry>prim_findfirst[raw]</entry>
</primitive>
<primitive name="isFail" arity="1">
<library>prim_standard</library>
<entry>prim_isFail[raw]</entry>
</primitive>
<primitive name="try" arity="1">
<library>prim_standard</library>
<entry>prim_try[raw]</entry>
......
......@@ -790,7 +790,11 @@ prim_readFileContents external
--- @param filename - The name of the file to be written.
--- @param contents - The contents to be written to the file.
writeFile :: String -> String -> IO ()
#ifdef __PAKCS__
writeFile f s = (prim_writeFile $## f) s
#else
writeFile f s = (prim_writeFile $## f) $## s
#endif
prim_writeFile :: String -> String -> IO ()
prim_writeFile external
......@@ -800,7 +804,11 @@ prim_writeFile external
--- @param filename - The name of the file to be written.
--- @param contents - The contents to be appended to the file.
appendFile :: String -> String -> IO ()
#ifdef __PAKCS__
appendFile f s = (prim_appendFile $## f) s
#else
appendFile f s = (prim_appendFile $## f) $## s
#endif
prim_appendFile :: String -> String -> IO ()
prim_appendFile external
......
......@@ -77,6 +77,7 @@ showMemInfo infos = concat $ intersperse ", " $
--- Print a human readable version of the current memory situation
--- of the Curry process.
printMemInfo :: IO ()
printMemInfo = getProcessInfos >>= putStrLn . showMemInfo
--- Print the time needed to execute a given IO action.
......@@ -129,6 +130,8 @@ profileSpace action = do
profileSpaceNF :: a -> IO ()
profileSpaceNF exp = profileSpace (seq (id $!! exp) done)
showInfoDiff :: [(ProcessInfo, Int)] -> [(ProcessInfo, Int)] -> ProcessInfo
-> String
showInfoDiff infos1 infos2 item =
show (maybe 0 id (lookup item infos2) - maybe 0 id (lookup item infos1))
......
......@@ -14,7 +14,16 @@ instance ConvertCurryHaskell C_ProcessInfo C_ProcessInfo where
fromCurry = id
getProcessInfos :: IO [(C_ProcessInfo, Int)]
#if __GLASGOW_HASKELL__ > 702
#if __GLASGOW_HASKELL__ > 802
getProcessInfos = do
stats <- getRTSStats
return [ (C_RunTime , fromIntegral (mutator_cpu_ns stats * 1000))
, (C_ElapsedTime , fromIntegral (mutator_elapsed_ns stats * 1000))
, (C_Heap , fromIntegral (max_live_bytes stats))
, (C_Memory , fromIntegral (max_live_bytes stats))
, (C_GarbageCollections, fromIntegral (gcs stats))
]
#elif __GLASGOW_HASKELL__ > 702
getProcessInfos = do
stats <- getGCStats
return [ (C_RunTime , floor (mutatorCpuSeconds stats * 1000))
......
......@@ -191,9 +191,9 @@ getRandomSeed =
getCPUTime >>= \msecs ->
let (CalendarTime y mo d h m s _) = toUTCTime time
#ifdef __PAKCS__
in return ((y+mo+d+h+m*s*msecs) `rem` mask)
in return ((y+mo+d+h+(m+1)*(s+1)*(msecs+1)) `rem` mask)
#else
in return ((y+mo+d+h+m*s*(msecs+1)) `mod` two16)
in return ((y+mo+d+h+(m+1)*(s+1)*(msecs+1)) `mod` two16)
#endif
--- Computes a random permutation of the given list.
......
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