ghc/tests/programs/jules_xref2/Main.hs

   1 -- partain: the failure (crashing) was w/ -prof-auto compilation
   2
   3 module Main where
   4
   5 xreff :: Int -> [String] -> Table -> Int -> String -> String
   6 xreff cc exs stab lineno [] = display (foldl delete stab exs)
   7 xreff cc exs stab lineno ('\n':cs) = xreff cc exs stab (lineno+1) cs
   8 xreff cc exs stab lineno (c:cs)
   9   = if (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') then
  10        case getRestWord cs of
  11          (word, rest) -> if (cc :: Int) == 0
  12           then   if stab == stab
  13                  then
  14                     xreff 1000 exs
  15                           (enter lineno stab (c:word)) lineno rest
  16                  else error "Force failed?!"
  17           else      xreff (cc-1) exs
  18                         (enter lineno stab (c:word)) lineno rest
  19       else xreff cc exs stab lineno cs
  20
  21 xref exceptions source = xreff 1000 exceptions ALeaf 1 source
  22
  23 getRestWord [] = ([], [])
  24 getRestWord xs@(x:xs')
  25    | (x >= 'a' && x <= 'z') || (x >= 'A' && x <= 'Z') || (x >= '0' && x <= '9')
  26    = case getRestWord xs' of
  27         (ys,zs) -> if (x >= 'A' && x <= 'Z')
  28                    then (toEnum (fromEnum x + (32::Int)):ys, zs)
  29                    else (x:ys, zs)
  30    | otherwise
  31    = ([],xs)
  32
  33 data Table = ALeaf | ABranch Table String [Int] Table deriving (Eq)
  34
  35 enter n ALeaf w = ABranch ALeaf w [n] ALeaf
  36 enter n (ABranch l k ns r) w
  37  = if w < k then ABranch (enter n l w) k ns r else
  38    if w > k then ABranch l k ns (enter n r w) else
  39                  ABranch l k (n:ns) r
  40
  41 delete ALeaf w              = ALeaf
  42 delete (ABranch l k ns r) w
  43  = if w < k then ABranch (delete l w) k ns r else
  44    if w > k then ABranch l k ns (delete r w) else
  45                  ABranch l k [] r
  46
  47 display :: Table -> String
  48 display t = display_a t ""
  49
  50 display_a :: Table -> String -> String
  51 display_a ALeaf acc = acc
  52 display_a (ABranch l k ns r) acc
  53  = display_a l (dispLine k ns ++ display_a r acc)
  54
  55 dispLine k [] = ""
  56 dispLine k ns = k ++ ":" ++ dispNos ns ++ "\n"
  57
  58 dispNos :: [Int] -> String
  59 dispNos []     = ""
  60 dispNos (n:ns) = ' ':(show n ++ dispNos ns)
  61
  62 main = do
  63     input <- getContents
  64     exceptions <- catch (readFile "exceptions") (\ e -> return "")
  65     putStr (xref (lines exceptions) input)
  66
  67 {- OLD 1.2:
  68 main = readChan stdin abort (\input ->
  69        readFile "exceptions"
  70                 (\errors     -> output (xref []                 input))
  71                 (\exceptions -> output (xref (lines exceptions) input)))
  72        where output s = appendChan stdout s abort done
  73 -}