Consistency with current PAKCS/KiCS2 system libraries improved

src/CPNS.curry

@@ -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

src/Findall.curry

@@ -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.

src/Findall.pakcs

@@ -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>

src/Prelude.curry

@@ -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

src/Profile.curry

@@ -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))
 

src/Profile.kics2

@@ -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))

src/Random.curry

@@ -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.