analysis and currydoc added to currytools

.gitignore

+# intermediate files
+*~
+.curry
+*.state

Makefile

+# Generate various tools for Curry
+
+# Required:
+# - installed Curry System (PAKCS or KiCS2) specified by variable CURRYSYSTEM
+# - root location of the Curry System specified by variable ROOT
+
+.PHONY: all
+all:
+	@cd currydoc  ; $(MAKE)
+
+.PHONY: clean
+clean: 
+	cd analysis  ; $(ROOT)/bin/cleancurry
+	cd currydoc  ; $(MAKE) clean

analysis/AnaCompleteness.curry

+-----------------------------------------------------------------------------
+-- Completeness analysis for Curry programs
+--
+-- This analysis checks for each function in a Curry program  whether
+-- this function is completely defined, i.e., reducible on all ground
+-- constructor terms
+--
+-- Johannes Koj, October 2000
+-- Michael Hanus, January 2002
+-----------------------------------------------------------------------------
+
+module AnaCompleteness(CompletenessType(..),analyseCompleteness) where
+
+import FlatCurry
+
+
+------------------------------------------------------------------------------
+-- The completeness analysis must be applied to complete programs,
+-- i.e., modules together with all their imported modules (although
+-- functions are locally checked, the definition of all data types
+-- used in the patterns are needed).
+-- It assigns to a FlatCurry program the list of all qualified function names
+-- together with a flag which is True if this function is completely
+-- defined on its input types (i.e., reducible for all ground data terms).
+
+-- The possible outcomes of the completeness analysis:
+data CompletenessType =
+     Complete       -- completely defined
+   | InComplete     -- incompletely defined
+   | InCompleteOr   -- incompletely defined in each branch of an "Or"
+
+analyseCompleteness :: Prog -> [((String,String),CompletenessType)]
+analyseCompleteness (Prog _ _ types funs _) = map anaFun funs
+ where
+  anaFun (Func name _ _ ftype (Rule vs e)) =
+                        (name, isComplete types (initialTypeEnv vs ftype) e)
+  anaFun (Func name _ _ _ (External _)) = (name, Complete)
+
+isComplete :: [TypeDecl] -> [(Expr,TypeExpr)] -> Expr -> CompletenessType
+isComplete _ _ (Var _)      = Complete
+isComplete _ _ (Lit _)      = Complete
+isComplete types typeEnv (Comb _ f es) =
+  if f==("Prelude","commit") && length es == 1
+  then isComplete types typeEnv (head es)
+  else Complete
+isComplete _ _ (Free _ _) = Complete
+isComplete _ _ (Let _ _) = Complete
+isComplete types typeEnv (Or e1 e2) =
+    combineOrResults (isComplete types typeEnv e1)
+                     (isComplete types typeEnv e2)
+isComplete types typeEnv (Case _ exp ces) =
+  case exp of
+    Var _ -> aux (getConstructors (lookupType exp typeEnv) types) ces
+    _ -> InComplete -- if the case argument is not a variable, we give up
+                    -- since we do not want to infer the expression type here
+  where
+    -- check for occurrences of all constructors in each case branch:
+    aux []    _  = Complete
+    aux (_:_) [] = InComplete
+    aux (_:_) (Branch (LPattern _)   _ : _) = InComplete
+    aux (c:cs) (Branch (Pattern i vs) e : ps) =
+        combineAndResults (aux (removeConstructor i (c:cs)) ps)
+              (isComplete types
+                          (makeTypeEnv vs (getConsArgTypes i (c:cs)) ++typeEnv)
+                          e)
+
+-- Combines the completeness results in different Or branches.
+combineOrResults Complete     _            = Complete
+combineOrResults InComplete   Complete     = Complete
+combineOrResults InComplete   InComplete   = InCompleteOr
+combineOrResults InComplete   InCompleteOr = InCompleteOr
+combineOrResults InCompleteOr Complete     = Complete
+combineOrResults InCompleteOr InComplete   = InCompleteOr
+combineOrResults InCompleteOr InCompleteOr = InCompleteOr
+
+-- Combines the completeness results in different case branches.
+combineAndResults InComplete   _            = InComplete
+combineAndResults Complete     Complete     = Complete
+combineAndResults Complete     InComplete   = InComplete
+combineAndResults Complete     InCompleteOr = InCompleteOr
+combineAndResults InCompleteOr Complete     = InCompleteOr
+combineAndResults InCompleteOr InComplete   = InComplete
+combineAndResults InCompleteOr InCompleteOr = InCompleteOr
+
+
+removeConstructor c1 [] = error ("Constructor "++show c1++" not found!!")
+removeConstructor c1 ((Cons c2 a vis ts):cs)
+        | c1==c2    = cs
+        | otherwise = (Cons c2 a vis ts):(removeConstructor c1 cs)
+
+getConsArgTypes c1 [] = error ("Constructor "++show c1++" not found!!")
+getConsArgTypes c1 (Cons c2 _ _ ts : cs)
+        | c1==c2    = ts
+        | otherwise = getConsArgTypes c1 cs
+
+-- Gets the list of all constructors for a given type.
+getConstructors :: TypeExpr -> [TypeDecl] -> [ConsDecl]
+getConstructors t (TypeSyn _ _ _ _ : types) = getConstructors t types
+getConstructors (TCons c1 as1) (Type c2 _ as2 cs : types)
+    | c1==("Prelude","Int")  || c1==("Prelude","Float")  || 
+      c1==("Prelude","Char") || c1==("Prelude","String")
+       = [Cons ("","") 0 Private []]
+    | c1==c2 = replace as2 as1 cs
+    | otherwise = getConstructors (TCons c1 as1) types
+ where
+   replace _ _ [] = []
+   replace ts1 ts2 ((Cons c ar vis ts):cns) =
+                    (Cons c ar vis (repTypes ts1 ts2 ts)):(replace ts1 ts2 cns)
+
+   repTypes ts1 ts2 ts = map (repType ts1 ts2) ts
+   repType ts1 ts2 (TVar v) = lookup ts1 ts2 v
+   repType ts1 ts2 (FuncType t1 t2) =
+                    FuncType (repType ts1 ts2 t1) (repType ts1 ts2 t2)
+   repType ts1 ts2 (TCons c ts) = TCons c (repTypes ts1 ts2 ts)
+
+   lookup [] _ v = TVar v
+   lookup (t1:ts1) (t2:ts2) v | v==t1     = t2
+                              | otherwise = lookup ts1 ts2 v
+
+-- This function returns the type of a case argument. Here we
+-- assume that a case argument is always a variable.
+lookupType e1 ((e2,t):ass) | e1==e2    = t
+                           | otherwise = lookupType e1 ass
+
+-- Computes an initial type environment for the parameters variables
+-- (represented by their indices) w.r.t. a given function type.
+initialTypeEnv :: [Int] -> TypeExpr -> [(Expr,TypeExpr)]
+initialTypeEnv [] _ = []
+initialTypeEnv (v:vs) (FuncType t1 t2) = (Var v,t1):(initialTypeEnv vs t2)
+
+-- Computes a type environment for the parameters of a case branch.
+makeTypeEnv [] _ = []
+makeTypeEnv (v:vs) (t:ts) = (Var v,t):(makeTypeEnv vs ts)
+

analysis/AnaDependency.curry

+-----------------------------------------------------------------------------
+-- A few base functions for analysing dependencies in FlatCurry programs:
+--
+-- Michael Hanus, February 2004
+-----------------------------------------------------------------------------
+
+module AnaDependency(funsInExpr, indirectlyDependent) where
+
+import FlatCurry
+import List
+import SetRBT
+import Sort(leqString)
+
+-- Computes the list of indirect dependencies for all functions.
+-- Argument: a list of function declarations
+-- Result: a list of pairs of qualified functions names and the corresponding
+--         called functions
+indirectlyDependent :: [FuncDecl] -> [(QName,[QName])]
+indirectlyDependent funs = map (\ (f,ds) -> (f,setRBT2list ds))
+                               (depsClosure (map directlyDependent funs))
+
+-- list of direct dependencies for all functions
+directlyDependent :: FuncDecl -> (QName,SetRBT QName)
+directlyDependent (Func f _ _ _ (Rule _ e))   = (f,funsInExpr e)
+directlyDependent (Func f _ _ _ (External _)) = (f,emptySet)
+
+-- compute all transitive dependencies between functions:
+depsClosure :: [(QName,SetRBT QName)] -> [(QName,SetRBT QName)]
+depsClosure directdeps = map (\ (f,ds)->(f,closure ds (setRBT2list ds)))
+                             directdeps
+ where
+  closure olddeps [] = olddeps
+  closure olddeps (f:fs) =
+     let newdeps = filter (\e->not (elemRBT e olddeps))
+                          (setRBT2list (getDeps directdeps f))
+      in closure (foldr insertRBT olddeps newdeps) (newdeps++fs)
+
+  getDeps [] _ = emptySet
+  getDeps ((f,ds):fdeps) f1 = if f==f1 then ds
+                                       else getDeps fdeps f1
+
+
+-- Gets the set of all functions (including partially applied functions)
+-- called in an expression:
+funsInExpr :: Expr -> SetRBT QName
+funsInExpr (Var _) = emptySet
+funsInExpr (Lit _) = emptySet
+funsInExpr (Comb ct f es) =
+  if isConstructorComb ct then unionMap funsInExpr es
+                          else insertRBT f (unionMap funsInExpr es)
+funsInExpr (Free _ e) = funsInExpr e
+funsInExpr (Let bs e) = unionRBT (unionMap (funsInExpr . snd) bs) (funsInExpr e)
+funsInExpr (Or e1 e2) = unionRBT (funsInExpr e1) (funsInExpr e2)
+funsInExpr (Case _ e bs) = unionRBT (funsInExpr e) (unionMap funsInBranch bs)
+                     where funsInBranch (Branch _ be) = funsInExpr be
+
+isConstructorComb ct = case ct of
+  ConsCall       -> True
+  ConsPartCall _ -> True
+  _              -> False
+
+unionMap f = foldr unionRBT emptySet . map f
+
+emptySet = emptySetRBT leqQName
+
+leqQName (m1,n1) (m2,n2) = leqString (m1++('.':n1)) (m2++('.':n2))
+
+-- end of AnaDependency
+

analysis/AnaIndeterminism.curry

+------------------------------------------------------------------------------
+-- Indeterminism analysis:
+-- check whether functions are indeterministic, i.e., contain an
+-- indirect/implicit call to a committed choice.
+--
+-- Michael Hanus, September 1999
+------------------------------------------------------------------------------
+
+module AnaIndeterminism(analyseIndeterminism,indetFunctions,
+                        choiceInExpr)   where
+
+import FlatCurry
+import List
+import AnaDependency
+
+------------------------------------------------------------------------------
+-- The indeterminism analysis must be applied to complete programs,
+-- i.e., modules together with all their imported modules.
+-- It assigns to a FlatCurry program the list of all qualified function names
+-- together with a flag which is True if this function might be defined
+-- in a indeterministic manner (i.e., contains an indirect/implicit call
+-- to a committed choice).
+
+analyseIndeterminism :: Prog -> [((String,String),Bool)]
+analyseIndeterminism (Prog _ _ _ funs _) = map anaFun alldeps
+  where
+    anaFun (name,depfuns) = (name, any (isIndetDefined funs) (name:depfuns))
+
+    alldeps = indirectlyDependent funs
+
+
+-- Computes the list of all indeterministic functions:
+indetFunctions funs = map fst (filter isIndet alldeps)
+  where
+    isIndet (name,depfuns) = any (isIndetDefined funs) (name:depfuns)
+
+    alldeps = indirectlyDependent funs
+
+
+-- (isIndetDefined fundecls f):
+-- Is a function f defined by an indeterministic rule?
+isIndetDefined :: [FuncDecl] -> (String,String) -> Bool
+isIndetDefined [] _ = False -- this case should occur only for constructors
+isIndetDefined (Func f _ _ _ def : funs) f1 =
+ if f==f1 then isIndetRule def
+          else isIndetDefined funs f1
+
+
+--- is a function directly (i.e., by its rhs) indeterministic?
+isIndeterministic (Func _ _ _ _ rule) = isIndetRule rule
+
+isIndetRule (Rule _ e) = choiceInExpr e
+isIndetRule (External _) = False
+
+-- check an expression for occurrences of committed choice or send:
+choiceInExpr :: Expr -> Bool
+choiceInExpr (Var _) = False
+choiceInExpr (Lit _) = False
+choiceInExpr (Comb _ f es) = f==("Prelude","commit") ||
+                             f==("Ports","send") || f==("Ports","doSend") ||
+                             any choiceInExpr es
+choiceInExpr (Free _ e) = choiceInExpr e
+choiceInExpr (Let bs e) = any choiceInExpr (map snd bs) || choiceInExpr e
+choiceInExpr (Or e1 e2) = choiceInExpr e1 || choiceInExpr e2
+choiceInExpr (Case _  e bs) = choiceInExpr e || any choiceInBranch bs
+                where choiceInBranch (Branch _ be) = choiceInExpr be
+
+-- end of AnaIndeterminism

analysis/AnaOpComplete.curry

+------------------------------------------------------------------------------
+-- Analysis for operational completeness:
+-- check whether functions are operational complete, i.e., calls only
+-- non-rigid functions
+--
+-- Michael Hanus, January 2004
+------------------------------------------------------------------------------
+
+module AnaOpComplete(analyseOpCompleteness)   where
+
+import FlatCurry
+import List
+import AnaDependency
+
+------------------------------------------------------------------------------
+-- The operational completeness analysis must be applied to complete programs,
+-- i.e., modules together with all their imported modules.
+-- It assigns to a FlatCurry program the list of all qualified function names
+-- together with a flag which is True if this function is operationally
+-- complete, i.e., does not call a rigid function.
+
+analyseOpCompleteness :: Prog -> [((String,String),Bool)]
+analyseOpCompleteness (Prog _ _ _ funs _) = map anaFun alldeps
+  where
+    anaFun (name,depfuns) = (name, all (isFlexDefined funs) (name:depfuns))
+
+    alldeps = indirectlyDependent funs
+
+
+-- (isFlexDefined fundecls f):
+-- Is a function f defined by a flexible rule?
+isFlexDefined :: [FuncDecl] -> (String,String) -> Bool
+isFlexDefined [] f =  -- this case should occur only for constructors
+                      -- and some special predefined functions
+   f `notElem` [("Prelude","findall"),("Prelude","findfirst")]
+isFlexDefined (Func f _ _ _ def : funs) f1 =
+ if f==f1 then isFlexRule def
+          else isFlexDefined funs f1
+
+isFlexRule (Rule _ e) = isFlexExpr e
+isFlexRule (External f) =
+   f `elem` ["Prelude.=:=","Prelude.success","Prelude.&",
+             "Prelude.&>","Prelude.return"]
+
+-- Checks whether an expression is flexible, i.e., can only suspend
+-- because of calls to other possibly rigid functions.
+
+isFlexExpr :: Expr -> Bool
+isFlexExpr (Var _)           = True
+isFlexExpr (Lit _)           = True
+isFlexExpr (Comb _ f args) =
+       f/=("Prelude","apply") -- apply suspends if arg 1 is unbound
+    && f/=("Prelude","commit")
+    && all isFlexExpr args
+isFlexExpr (Free _ e)        = isFlexExpr e
+isFlexExpr (Let bs e)        = all isFlexExpr (map snd bs) && isFlexExpr e
+isFlexExpr (Or e1 e2)        = isFlexExpr e1 && isFlexExpr e2
+isFlexExpr (Case ctype e bs) = ctype==Flex &&
+                         all isFlexExpr (e : map (\(Branch _ be)->be) bs)
+
+
+-- end of AnaOpComplete

analysis/AnaOverlapping.curry

+------------------------------------------------------------------------------
+-- Overlapping analysis:
+-- check whether functions are defined with overlapping left-hand sides
+-- (i.e., whether they are defined with OR expressions)
+--
+-- Michael Hanus, February 2005
+------------------------------------------------------------------------------
+
+module AnaOverlapping(analyseOverlappings,orInExpr) where
+
+import FlatCurry
+
+------------------------------------------------------------------------------
+-- The overlapping analysis can be applied to individual modules.
+-- It assigns to a FlatCurry module the list of all qualified function names
+-- together with a flag which is True if this function is defined
+-- with overlapping left-hand sides.
+
+analyseOverlappings :: Prog -> [((String,String),Bool)]
+analyseOverlappings (Prog _ _ _ funs _) = map overlapFun funs
+  where
+    overlapFun (Func name _ _ _ (Rule _ e))   = (name, orInExpr e)
+    overlapFun (Func name _ _ _ (External _)) = (name, False)
+
+--------------------------------------------------------------------------
+-- Check an expression for occurrences of OR:
+orInExpr :: Expr -> Bool
+orInExpr (Var _) = False
+orInExpr (Lit _) = False
+orInExpr (Comb _ f es) =
+  if f==("Prelude","commit")
+  then False -- OR in committed choice have only local effects
+  else any orInExpr es
+orInExpr (Free _ e) = orInExpr e
+orInExpr (Let bs e) = any orInExpr (map snd bs) || orInExpr e
+orInExpr (Or _ _) = True
+orInExpr (Case _ e bs) = orInExpr e || any orInBranch bs
+                   where orInBranch (Branch _ be) = orInExpr be
+

currydoc/CurryDoc.curry

+----------------------------------------------------------------------
+--- Implementation of CurryDoc, a utility for the automatic
+--- generation of HTML documentation from Curry programs.
+---
+--- @author Michael Hanus
+----------------------------------------------------------------------
+
+-- * All comments to be put into the HTML documentation must be
+--   prefixed by "--- " (also in literate programs!).
+--
+-- * The comment of a module must occur before the first "module" or
+--   "import" line of this module.
+--
+-- * The comment of a function or datatype must occur before the
+--   first definition of this function or datatype.
+--
+-- * The comments can contain at the end several special comments:
+--   @cons id comment   --> a comment for a constructor of a datatype
+--   @param id comment  --> comment for function parameter id
+--                          (list all parameters in left-to-right order)
+--   @return comment    --> comments for the return value of a function
+--   @author comment    --> the author of a module (only in module comments)
+--   @version comment   --> the version of a module (only in module comments)
+--
+-- * Current restriction: doesn't properly work for infix operator definitions
+--   without a type definition (so it should be always included)
+
+module CurryDoc where
+
+import CurryDocParams
+import CurryDocRead
+import CurryDocHtml
+import CurryDocTeX
+import FlatCurry
+import System
+import Time
+import List
+import Directory
+import FileGoodies
+import AnaOverlapping
+import AnaCompleteness
+import AnaIndeterminism
+import AnaOpComplete
+import Distribution
+
+--------------------------------------------------------------------------
+-- Global definitions:
+
+-- Version of currydoc
+currydocVersion = "Version 0.5.1 of April 27, 2012"
+
+-- Directory where include files for generated documention (e.g., icons,
+-- css, tex includes) are stored:
+includeDir = installDir++"/include"
+
+--------------------------------------------------------------------------
+-- Check arguments and call main function:
+main = do
+  args <- getArgs
+  processArgs defaultCurryDocParams args
+
+processArgs docparams args = do
+  case args of
+    ("--nomarkdown":margs) ->
+        processArgs (setMarkDown False docparams) margs
+    ("--html":margs) ->
+        processArgs (setDocType HtmlDoc docparams) margs
+    ("--tex":margs) ->
+        processArgs (setDocType TexDoc docparams) margs
+    ["--noindexhtml",docdir,modname] ->
+       makeCompleteDoc (setIndex False (setDocType HtmlDoc docparams))
+                       True docdir (stripSuffix modname)
+    ("--onlyindexhtml":docdir:modnames) ->
+                        makeIndexPages docdir (map stripSuffix modnames)
+    (('-':_):_) -> putStrLn usageMessage
+    [modname] ->
+        makeCompleteDoc docparams (docType docparams == HtmlDoc)
+                        ("DOC_"++stripSuffix modname) (stripSuffix modname)
+    [docdir,modname] ->
+        makeCompleteDoc docparams (docType docparams == HtmlDoc) docdir
+                        (stripSuffix modname)
+    _ -> putStrLn usageMessage
+
+usageMessage =
+ "ERROR: Illegal arguments for currydoc\n" ++
+ "Usage: currydoc [--nomarkdown] [--html|--tex] <module_name>\n" ++
+ "       currydoc [--nomarkdown] [--html|--tex] <doc directory> <module_name>\n" ++
+ "       currydoc [--nomarkdown] --noindexhtml <doc directory> <module_name>\n" ++
+ "       currydoc --onlyindexhtml <doc directory> <module_names>\n"
+
+-- create directory if not existent:
+createDir :: String -> IO ()
+createDir dir = do
+  exdir <- doesDirectoryExist dir
+  if exdir then done else system ("mkdir "++dir) >> done
+
+--------------------------------------------------------------------------
+--- The main function of the CurryDoc utility.
+--- @param withindex - True if the index pages should also be generated
+--- @param recursive - True if the documentation for the imported modules
+---                    should be also generated (if necessary)
+--- @param docdir - the directory name containing all documentation files
+--- @param modname - the name of the main module to be documented
+makeCompleteDoc :: DocParams -> Bool -> String -> String -> IO ()
+makeCompleteDoc docparams recursive docdir modname = do
+  putStrLn("CurryDoc ("++currydocVersion++") - the Curry Documentation Tool\n")
+  prepareDocDir (docType docparams) docdir
+  -- parsing source program:
+  callFrontend FCY modname
+  (alltypes,allfuns,allops) <- readFlatCurryWithImports [modname]
+  progname <- findSourceFileInLoadPath modname
+  makeDocIfNecessary docparams recursive docdir
+                     (genAnaInfo (Prog modname [] alltypes allfuns allops))
+                     progname
+  time <- getLocalTime
+  if withIndex docparams
+   then do genMainIndexPage     currydocVersion time docdir [modname]
+           genFunctionIndexPage currydocVersion time docdir allfuns
+           genConsIndexPage     currydocVersion time docdir alltypes
+   else done
+  -- change access rights to readable for everybody:
+  system ("chmod -R go+rX "++docdir)
+  done
+
+--- Generate only the index pages for a list of (already compiled!) modules:
+makeIndexPages :: String -> [String] -> IO ()
+makeIndexPages docdir modnames = do
+  putStrLn("CurryDoc ("++currydocVersion++") - the Curry Documentation Tool\n")
+  prepareDocDir HtmlDoc docdir
+  (alltypes,allfuns,_) <- readFlatCurryWithImports modnames
+  time <- getLocalTime
+  genMainIndexPage     currydocVersion time docdir modnames
+  genFunctionIndexPage currydocVersion time docdir allfuns
+  genConsIndexPage     currydocVersion time docdir alltypes
+  -- change access rights to readable for everybody:
+  system ("chmod -R go+rX "++docdir)
+  done
+
+-- create documentation directory (if necessary) with gifs and stylesheets:
+prepareDocDir :: DocType -> String -> IO ()
+prepareDocDir HtmlDoc docdir = do
+  createDir docdir
+  putStrLn ("Copying icons into documentation directory \""++docdir++"\"...")
+  -- copying all icons:
+  copyIncludeIfPresent docdir "currydocicons/*.gif"
+  -- copy style sheet:
+  copyIncludeIfPresent docdir "currydoc.css"
+prepareDocDir TexDoc docdir = do
+  createDir docdir
+  putStrLn $ "Copy macros into documentation directory \""++docdir++"\"..."
+  copyIncludeIfPresent docdir "currydoc.tex"
+
+copyIncludeIfPresent docdir inclfile = do
+  existIDir <- doesDirectoryExist includeDir
+  if existIDir
+   then system ("cp "++includeDir++"/"++inclfile++" "++docdir) >> done
+   else done
+
+-- generate all analysis infos:
+genAnaInfo prog =
+  AnaInfo (getFunctionInfo (analyseOverlappings prog))
+          (getFunctionInfo (analyseCompleteness prog))
+          (getFunctionInfo (analyseIndeterminism prog))
+          (getFunctionInfo (analyseOpCompleteness prog))
+
+-- generate documentation for a single module:
+makeDoc :: DocParams -> Bool -> String -> AnaInfo -> String -> IO ()
+makeDoc docparams recursive docdir anainfo progname = do
+  putStrLn ("Reading comments from file \""++progname++".curry\"...")
+  (modcmts,progcmts) <- readComments (progname++".curry")
+  makeDocWithComments (docType docparams) docparams recursive docdir
+                      anainfo progname modcmts progcmts
+
+makeDocWithComments HtmlDoc docparams recursive docdir anainfo progname
+                    modcmts progcmts = do
+  time <- getLocalTime
+  (imports,hexps) <- generateHtmlDocs currydocVersion time docparams anainfo
+                                      progname modcmts progcmts
+  let outfile = docdir++"/"++getLastName progname++".html"
+  putStrLn $ "Writing documentation to \""++outfile++"\"..."
+  writeFile outfile (showDocCSS ("Module "++getLastName progname) hexps)
+  translateSource2ColoredHtml docdir progname
+  if recursive
+   then mapIO_ (makeDocIfNecessary docparams recursive docdir anainfo) imports
+   else done
+
+makeDocWithComments TexDoc docparams recursive docdir anainfo progname
+                    modcmts progcmts = do
+  (imports,textxt) <- generateTexDocs docparams anainfo progname modcmts progcmts
+  let outfile = docdir++"/"++getLastName progname++".tex"
+  putStrLn $ "Writing documentation to \""++outfile++"\"..."
+  writeFile outfile textxt
+  if recursive
+   then mapIO_ (makeDocIfNecessary docparams recursive docdir anainfo) imports
+   else done
+
+
+--- Generates the documentation for a module if it is necessary.
+--- I.e., the documentation is generated if no previous documentation
+--- file exists or if the existing documentation file is older than
+--- the FlatCurry file.
+makeDocIfNecessary :: DocParams -> Bool -> String -> AnaInfo -> String -> IO ()
+makeDocIfNecessary docparams recursive docdir anainfo modname = do
+  progname <- findSourceFileInLoadPath modname
+  let docfile = docdir ++ "/" ++ getLastName progname ++
+                (if docType docparams == HtmlDoc then ".html" else ".tex")
+  docexists <- doesFileExist docfile
+  if not docexists
+   then copyOrMakeDoc docparams recursive docdir anainfo progname 
+   else do ctime  <- getModificationTime (flatCurryFileName progname)
+           dftime <- getModificationTime docfile
+           if compareClockTime ctime dftime == GT
+            then copyOrMakeDoc docparams recursive docdir anainfo progname
+            else if recursive
+                 then do imports <- getImports progname
+                         mapIO_ (makeDocIfNecessary docparams recursive docdir
+                                                    anainfo)
+                                imports
+                 else done
+
+-- get imports of a program by reading the interface, if possible:
+getImports progname = do
+  let fintname = flatCurryIntName progname
+  fintexists <- doesFileExist fintname
+  (Prog _ imports _ _ _) <- if fintexists
+                            then readFlatCurryFile fintname
+                            else readFlatCurryFile (flatCurryFileName progname)
+  return imports
+
+copyOrMakeDoc :: DocParams -> Bool -> String -> AnaInfo -> String -> IO ()
+copyOrMakeDoc docparams recursive docdir anainfo progname = do
+  hasCopied <- copyDocIfPossible docparams docdir progname
+  if hasCopied then done
+               else makeDoc docparams recursive docdir anainfo progname
+
+--- Copy the documentation file from standard documentation directoy "CDOC"
+--- (used for documentation of system libraries) if possible.
+--- Returns true if the copy was possible.
+copyDocIfPossible :: DocParams -> String -> String -> IO Bool
+copyDocIfPossible docparams docdir progname =
+  if docType docparams == TexDoc
+  then return False -- ignore copying for TeX docs
+  else do
+     let docprogname = getDirName progname++"/CDOC/"++getLastName progname
+     docexists <- doesFileExist (docprogname++".html")
+     if not docexists
+      then return False
+      else
+       do ctime <- getModificationTime (flatCurryFileName progname)