ghc/tests/codeGen/should_run/cg033.hs

   1 -- !! worker/wrapper turns ( \ <absent> -> Int# ) function
   2 -- !! into Int# -- WRONG
   3
   4 import PrelBase --ghc1.3
   5
   6 main = putStr (shows true_or_false "\n")
   7   where
   8     true_or_false
   9       = case (cmp_name True imp1 imp2) of
  10           -1# -> False
  11           0#  -> True
  12           1#  -> False
  13
  14     imp1 = Imp s "Imp1" s s
  15     imp2 = Imp s "Imp2" s s
  16
  17     s = "String!"
  18
  19 -- taken from compiler: basicTypes/ProtoName.lhs
  20
  21 cmp_name :: Bool -> ProtoName -> ProtoName -> Int#
  22
  23 cmp_name by_local (Unk n1) (Unk n2)        = cmpString n1 n2
  24 cmp_name by_local (Unk n1) (Imp m n2 _ o2) = cmpString n1 (if by_local then o2 else n2)
  25 cmp_name by_local (Unk n1) (Prel nm)
  26   =  let  (_, n2) = getOrigName nm  in
  27      cmpString n1 n2
  28
  29 cmp_name by_local (Prel n1) (Prel n2) = cmpName n1 n2
  30
  31 cmp_name True  (Imp _ _ _ o1) (Imp _ _ _ o2) = cmpString o1 o2
  32
  33 cmp_name False (Imp m1 n1 _ _) (Imp m2 n2 _ _)
  34   = case cmpString n1 n2 of {
  35       -1# -> -1#;
  36       0# -> case cmpString m1 m2 of {
  37                0# -> 0#;
  38                xxx -> if null m1 || null m2
  39                       then 0#
  40                       else xxx
  41              };
  42       _ -> 1#
  43     }
  44
  45 cmp_name True (Imp _ _ _ o1) (Prel nm)
  46   = let
  47         (_, n2) = getOrigName nm
  48     in
  49     cmpString o1 n2
  50
  51 cmp_name False (Imp m1 n1 _ _) (Prel nm)
  52   = case getOrigName nm   of { (m2, n2) ->
  53     case cmpString n1 n2 of { -1# -> -1#; 0# -> cmpString m1 m2; _ -> 1# }}
  54
  55 cmp_name by_local other_p1 other_p2
  56   = case cmp_name by_local other_p2 other_p1 of -- compare the other way around
  57       -1#  -> 1#
  58       0#  -> 0#
  59       _ -> -1#
  60
  61 data ProtoName
  62   = Unk         String  -- local name in module
  63
  64   | Imp         String  -- name of defining module
  65                 String  -- name used in defining name
  66                 String  -- name of the module whose interface told me
  67                         -- about this thing
  68                 String  -- occurrence name
  69
  70   | Prel        String{-Name-}
  71
  72 cmpString, cmpName :: String -> String -> Int#
  73 cmpString a b = 0#
  74 cmpName = cmpString
  75
  76 getOrigName :: String -> (String, String)
  77 getOrigName x = ("MODULE", x)