Ticket #8793: no-tuple.dump-simpl

File no-tuple.dump-simpl, 2.0 KB (added by cdk, 13 months ago)

slow core - no tuple (2nd method)

Line 
1    case ipv3 of _ {
2      Empty -> (# ipv2, Nothing @ a #);
3      Bucket rb ds ds3 ->
4        case ==# rb x# of _ {
5          False ->
6            letrec {
7              a1
8                :: (Bucket a -> IO ())
9                   -> Bucket a -> State# RealWorld -> (# State# RealWorld, Maybe a #)
10              a1 =
11                \ (ds4 :: Bucket a -> IO ()) (ds5 :: Bucket a) (eta :: State# RealWorld) ->
12                  case ds5 of _ {
13                    Empty -> (# eta, Nothing @ a #);
14                    Bucket rb1 ds6 ds7 ->
15                      case ==# rb1 x# of _ {
16                        False ->
17                          a1 (\ (x :: Bucket a) -> ds4 (Bucket @ a rb1 ds6 x)) ds7 eta;
18                        True ->
19                          case w ds6 of _ {
20                            Nothing ->
21                              case ((ds4 ds7) `cast` ...) eta of _ { (# ipv4, _ #) ->
22                              case readIntOffAddr# @ RealWorld ww1 0 ipv4
23                              of _ { (# ipv6, ipv7 #) ->
24                              case writeIntOffAddr# @ RealWorld ww1 0 (-# ipv7 1) ipv6
25                              of s2 { __DEFAULT ->
26                              case touch# @ ForeignPtrContents ww2 s2 of s' { __DEFAULT ->
27                              (# s', Just @ a ds6 #)
28                              }
29                              }
30                              }
31                              };
32                            Just v ->
33                              case ((ds4 (Bucket @ a rb1 v ds7)) `cast` ...) eta
34                              of _ { (# ipv4, _ #) ->
35                              (# ipv4, Just @ a ds6 #)
36                              }
37                          }
38                      }
39                  }; } in
40            a1
41              ((\ (x :: Bucket a) (eta :: State# RealWorld) ->
42                  case writeArray#
43                         @ RealWorld @ (Bucket a) a n# (Bucket @ a rb ds x) eta
44                  of s1# { __DEFAULT -> (# s1#, () #) }) `cast` ...)
45              ds3
46              ipv2;