Hi,
I have written a small application which uses Mutable Arrays to fixpoint
boolean equations. It builds and runs, but slowly! In an attempt to see
what is going on I am trying to build a profiled version. I have built
all modules with -O2 -prof -auto-all -fvia-C (via-C doesn't seem to
solve the problem). However, this refuses to link because of undefined
symbols, here is a bit of output from the build ....
gmake
rm -f STRobdd.o
ghc -c STRobdd.hs -cpp -fvia-C -O2 -prof -auto-all -syslib hbc -syslib ghc
NOTE: Simplifier still going after 4 iterations; bailing out.
ghc: module version unchanged at 8
rm -f fixpoint.o
ghc -c fixpoint.hs -cpp -fvia-C -O2 -prof -auto-all -syslib hbc -syslib ghc
NOTE: Simplifier still going after 4 iterations; bailing out.
ghc: module version unchanged at 59
rm -f ht
ghc -o ht -cpp -fvia-C -O2 -prof -auto-all -syslib hbc -syslib ghc fixpoint.o
STHashtable.o STRobdd.o BoolExpr.o BoolEqns.o ParseBEqns.o
Undefined first referenced
symbol in file
CC_STRobddZdSTRobddZdinitZurobddZdAUTO_struct fixpoint.o
CC_STRobddZdSTRobddZdinitZurobddZdAUTOZdDUPD_struct fixpoint.o
CC_STRobddZdSTRobddZdinitZurobddZdAUTO fixpoint.o
CC_STRobddZdSTRobddZdinitZurobddZdAUTOZdDUPD fixpoint.o
ld: fatal: Symbol referencing errors. No output written to ht
gmake: *** [ht] Error 1
Looking at fixpoint.o with ld -m reveals that these are the only
call-centre related symbols that are undefined.
I attach fixpoint.hs (please, no laughing ... though helpful advice
would be welcomed) below. If you need more info, just let me know.
regards,
k
module Main (main) where
import List (sort, nub)
import STRobdd
import BoolExpr
import BoolEqns
import STHashtable
import ParseBEqns
import System
import Maybe
import Char
import IO
import ST
import Unsafe (trace)
-- Splits <alphanum><alpha><numeric> into <alphanum><alpha> and <numeric> components
splitName :: String -> (String, Int)
splitName nm = splitName_helper (reverse nm)
splitName_helper :: String -> (String, Int)
splitName_helper [] = ([], 0)
splitName_helper nm@(x:xs) = if not (isDigit x) then
(reverse nm, 0)
else
let (stem, num) = splitName_helper xs in
(stem, (digitToInt x) + (num * 10))
resetDependentFuncs :: (String, Int) -> FuncDefWorkMap -> FuncDefWorkMap
resetDependentFuncs (stem, gen) fm =
map (\r@(fname, (args, rec_exp, fns, exp_row)) ->
let (fname_stem, fname_gen) = splitName fname in
if (fname_stem == stem) && (fname_gen > gen) then
(fname, (args, rec_exp, BFalse:fns, -2))
else
r)
fm
iterFix :: (Bool, FuncDefWorkMap, FuncDefWorkMap, ST_Robdd s) ->
(String, FuncDefWorkInfo) ->
ST s (Bool, FuncDefWorkMap, FuncDefWorkMap, ST_Robdd s)
iterFix (stable, titer, fm, robdd) (fname, (args, rec_exp, fns, fn_row)) =
let fnplus1 = subBExprFuns rec_exp fm in
do
new_exp_row <- buildRobdd fnplus1 robdd
new_exp <- mkBExp robdd new_exp_row
unchanged <- return (new_exp_row == fn_row)
fm' <- return (if unchanged then
fm
else
resetDependentFuncs (splitName fname) fm)
titer' <- return (if unchanged then
titer
else
resetDependentFuncs (splitName fname) titer)
return (stable && unchanged, -- Unchanged ??
(fname, (args, rec_exp, (new_exp:fns), new_exp_row)):titer',
fm',
robdd)
fixFuncs_helper :: FuncDefWorkMap -> ST_Robdd s -> ST s FuncDefWorkMap
fixFuncs_helper fm robdd = -- return fm
do
(stable, fm', _, _) <- foldM iterFix
(True, [], fm, robdd)
fm
if stable then
return fm'
else
fixFuncs_helper fm' robdd
-- Maps a function definition to the first guess, false
init_fenv :: FuncDef -> (String, FuncDefWorkInfo)
init_fenv (nm, (args,exp)) = (nm,(args, exp, [BFalse], (-2)))
-- Takes the input list of functions and returns the fixed version of them
fixFuncs :: [FuncDef] -> [FuncDef]
fixFuncs funcs =
-- Find all free variables from function expressions
let varord = sort (nub (foldr (\(_,(args,_)) l -> args ++ l)
[] funcs)) in
-- funcs_map holds each generation of function. First generation is false.
let funcs_map =
map init_fenv funcs in
-- Need to create a state thread to run fixpointer (which uses mutable arrays)
let fixed_funcs_env =
runST( do
-- Create Robdd to hold boolean expressions
robdd <- init_robdd 4092 varord
fixFuncs_helper funcs_map robdd) in
map (\(nm, (args, _, (fn:_),_)) -> (nm, (args,fn))) fixed_funcs_env
main :: IO ()
main = do pname <- getProgName
putStr (pname ++ ": Version 2.01\n")
in_string <- getContents -- stdin
let inpFunc = (parseBEqns.beLexer) in_string in
let fixed_funcs = fixFuncs inpFunc in
do printFuncList fixed_funcs
--
wot, no .sig?
