Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC

Commits:

24 changed files:

Changes:

  • .gitlab/ci.sh
    ... ... @@ -1106,7 +1106,7 @@ if [ "${CI_COMMIT_BRANCH:-}" == "master" ] && [ "${CI_PROJECT_PATH:-}" == "ghc/
    1106 1106
       fi
    
    1107 1107
     fi
    
    1108 1108
     if [ -n "${IGNORE_PERF_FAILURES:-}" ]; then
    
    1109
    -  RUNTEST_ARGS=( "${RUNTEST_ARGS[@]:-}" "--ignore-perf-failures=$IGNORE_PERF_FAILURES" )
    
    1109
    +  RUNTEST_ARGS="${RUNTEST_ARGS:-} --ignore-perf-failures=$IGNORE_PERF_FAILURES"
    
    1110 1110
     fi
    
    1111 1111
     
    
    1112 1112
     if [[ -z ${BIGNUM_BACKEND:-} ]]; then BIGNUM_BACKEND=gmp; fi
    

  • rts/Capability.c
    ... ... @@ -1396,7 +1396,9 @@ bool checkSparkCountInvariant (void)
    1396 1396
         /* The invariant is
    
    1397 1397
          *   created = converted + remaining + gcd + fizzled
    
    1398 1398
          */
    
    1399
    -    debugTrace(DEBUG_sparks,"spark invariant: %ld == %ld + %ld + %ld + %ld "
    
    1399
    +    debugTrace(DEBUG_sparks,"spark invariant: %" FMT_Word " == "
    
    1400
    +                            "%" FMT_Word " + %" FMT_Word64 " + "
    
    1401
    +                            "%" FMT_Word " + %" FMT_Word " "
    
    1400 1402
                                 "(created == converted + remaining + gcd + fizzled)",
    
    1401 1403
                                 sparks.created, sparks.converted, remaining,
    
    1402 1404
                                 sparks.gcd, sparks.fizzled);
    

  • rts/IOManager.c
    ... ... @@ -833,7 +833,9 @@ static void insertIntoSleepingQueue(CapIOManager *iomgr, StgTSO *tso, LowResTime
    833 833
     /* CMM primop. Result is true on success, or false on allocation failure. */
    
    834 834
     bool syncDelay(CapIOManager *iomgr, StgTSO *tso, HsInt us_delay)
    
    835 835
     {
    
    836
    -    debugTrace(DEBUG_iomanager, "thread %ld waiting for %lld us", tso->id, us_delay);
    
    836
    +    debugTrace(DEBUG_iomanager, "thread %" FMT_StgThreadID
    
    837
    +                                " waiting for %" FMT_Word " us",
    
    838
    +                                tso->id, us_delay);
    
    837 839
         ASSERT(tso->why_blocked == NotBlocked);
    
    838 840
         switch (iomgr_type) {
    
    839 841
     #if defined(IOMGR_ENABLED_SELECT)
    

  • rts/Messages.c
    ... ... @@ -134,8 +134,8 @@ loop:
    134 134
         if (i == &stg_MSG_TRY_WAKEUP_info)
    
    135 135
         {
    
    136 136
             StgTSO *tso = ((MessageWakeup *)m)->tso;
    
    137
    -        debugTraceCap(DEBUG_sched, cap, "message: try wakeup thread %"
    
    138
    -                      FMT_StgThreadID, tso->id);
    
    137
    +        debugTraceCap(DEBUG_sched, cap,
    
    138
    +                      "message: try wakeup thread %" FMT_StgThreadID, tso->id);
    
    139 139
             tryWakeupThread(cap, tso);
    
    140 140
         }
    
    141 141
         else if (i == &stg_MSG_THROWTO_info)
    
    ... ... @@ -150,8 +150,8 @@ loop:
    150 150
                 goto loop;
    
    151 151
             }
    
    152 152
     
    
    153
    -        debugTraceCap(DEBUG_sched, cap, "message: throwTo %ld -> %ld",
    
    154
    -                      (W_)t->source->id, (W_)t->target->id);
    
    153
    +        debugTraceCap(DEBUG_sched, cap, "message: throwTo %" FMT_StgThreadID
    
    154
    +                      " -> %" FMT_StgThreadID, t->source->id, t->target->id);
    
    155 155
     
    
    156 156
             r = throwToMsg(cap, t);
    
    157 157
     
    

  • rts/Printer.c
    ... ... @@ -554,7 +554,7 @@ printSmallBitmap( StgPtr spBottom, StgPtr payload, StgWord bitmap,
    554 554
         uint32_t i;
    
    555 555
     
    
    556 556
         for(i = 0; i < size; i++, bitmap >>= 1 ) {
    
    557
    -        debugBelch("   stk[%ld] (%p) = ", (long)(spBottom-(payload+i)), payload+i);
    
    557
    +        debugBelch("   stk[%td] (%p) = ", spBottom-(payload+i), payload+i);
    
    558 558
             if ((bitmap & 1) == 0) {
    
    559 559
                 printPtr((P_)payload[i]);
    
    560 560
                 debugBelch(" -- ");
    
    ... ... @@ -577,7 +577,7 @@ printLargeBitmap( StgPtr spBottom, StgPtr payload, StgLargeBitmap* large_bitmap,
    577 577
             StgWord bitmap = large_bitmap->bitmap[bmp];
    
    578 578
             j = 0;
    
    579 579
             for(; i < size && j < BITS_IN(W_); j++, i++, bitmap >>= 1 ) {
    
    580
    -            debugBelch("   stk[%" FMT_Word "] (%p) = ", (W_)(spBottom-(payload+i)), payload+i);
    
    580
    +            debugBelch("   stk[%td] (%p) = ", spBottom-(payload+i), payload+i);
    
    581 581
                 if ((bitmap & 1) == 0) {
    
    582 582
                     printPtr((P_)payload[i]);
    
    583 583
                     debugBelch(" -- ");
    

  • rts/STM.c
    ... ... @@ -134,7 +134,8 @@ static int shake(void) {
    134 134
       StgTRecHeader *__t = (_t);                                                    \
    
    135 135
       StgTRecChunk *__c = __t -> current_chunk;                                     \
    
    136 136
       StgWord __limit = __c -> next_entry_idx;                                      \
    
    137
    -  TRACE("%p : FOR_EACH_ENTRY, current_chunk=%p limit=%ld", __t, __c, __limit);  \
    
    137
    +  TRACE("%p : FOR_EACH_ENTRY, current_chunk=%p limit=%" FMT_Word,               \
    
    138
    +              __t, __c, __limit);                                               \
    
    138 139
       while (__c != END_STM_CHUNK_LIST) {                                           \
    
    139 140
         StgWord __i;                                                                \
    
    140 141
         for (__i = 0; __i < __limit; __i ++) {                                      \
    
    ... ... @@ -780,7 +781,7 @@ static StgBool validate_and_acquire_ownership (Capability *cap,
    780 781
                 result = false;
    
    781 782
                 BREAK_FOR_EACH;
    
    782 783
               } else {
    
    783
    -            TRACE("%p : need to check version %ld", trec, e -> num_updates);
    
    784
    +            TRACE("%p : need to check version %" FMT_Int, trec, e->num_updates);
    
    784 785
               }
    
    785 786
             });
    
    786 787
           }
    
    ... ... @@ -815,7 +816,8 @@ static StgBool check_read_only(StgTRecHeader *trec STG_UNUSED) {
    815 816
           StgTVar *s;
    
    816 817
           s = e -> tvar;
    
    817 818
           if (entry_is_read_only(e)) {
    
    818
    -        TRACE("%p : check_read_only for TVar %p, saw %ld", trec, s, e -> num_updates);
    
    819
    +        TRACE("%p : check_read_only for TVar %p, saw %" FMT_Int,
    
    820
    +              trec, s, e->num_updates);
    
    819 821
     
    
    820 822
             // We must first load current_value then num_updates; this is inverse of
    
    821 823
             // the order of the stores in stmCommitTransaction.
    
    ... ... @@ -1199,7 +1201,7 @@ of these false-positives causing actual issues.
    1199 1201
     StgBool stmValidateNestOfTransactions(Capability *cap, StgTRecHeader *trec, StgBool optimistically) {
    
    1200 1202
       StgTRecHeader *t;
    
    1201 1203
     
    
    1202
    -  TRACE("%p : stmValidateNestOfTransactions, %b", trec, optimistically);
    
    1204
    +  TRACE("%p : stmValidateNestOfTransactions, %d", trec, optimistically);
    
    1203 1205
       ASSERT(trec != NO_TREC);
    
    1204 1206
       ASSERT((trec -> state == TREC_ACTIVE) ||
    
    1205 1207
              (trec -> state == TREC_WAITING) ||
    

  • rts/Schedule.c
    ... ... @@ -1157,8 +1157,9 @@ scheduleHandleHeapOverflow( Capability *cap, StgTSO *t )
    1157 1157
     
    
    1158 1158
     #if defined(DEBUG)
    
    1159 1159
             debugTrace(DEBUG_sched,
    
    1160
    -                   "--<< thread %ld (%s) stopped: requesting a large block (size %ld)\n",
    
    1161
    -                   (long)t->id, what_next_strs[t->what_next], blocks);
    
    1160
    +                   "--<< thread %" FMT_StgThreadID " (%s) stopped: "
    
    1161
    +                   "requesting a large block (size %" FMT_Word ")\n",
    
    1162
    +                   t->id, what_next_strs[t->what_next], blocks);
    
    1162 1163
     #endif
    
    1163 1164
     
    
    1164 1165
             // don't do this if the nursery is (nearly) full, we'll GC first.
    

  • rts/Sparks.c
    ... ... @@ -140,7 +140,8 @@ pruneSparkQueue (bool nonmovingMarkFinished, Capability *cap)
    140 140
         pool->top     &= pool->moduloSize;
    
    141 141
     
    
    142 142
         debugTrace(DEBUG_sparks,
    
    143
    -               "markSparkQueue: current spark queue len=%ld; (hd=%ld; tl=%ld)",
    
    143
    +               "markSparkQueue: current spark queue len=%ld; "
    
    144
    +               "(hd=%" FMT_Int "; tl=%" FMT_Int ")",
    
    144 145
                    sparkPoolSize(pool), pool->bottom, pool->top);
    
    145 146
     
    
    146 147
         ASSERT_WSDEQUE_INVARIANTS(pool);
    
    ... ... @@ -288,7 +289,7 @@ pruneSparkQueue (bool nonmovingMarkFinished, Capability *cap)
    288 289
         debugTrace(DEBUG_sparks, "pruned %d sparks", pruned_sparks);
    
    289 290
     
    
    290 291
         debugTrace(DEBUG_sparks,
    
    291
    -               "new spark queue len=%ld; (hd=%ld; tl=%ld)",
    
    292
    +               "new spark queue len=%ld; (hd=%" FMT_Int "; tl=%" FMT_Int ")",
    
    292 293
                    sparkPoolSize(pool), pool->bottom, pool->top);
    
    293 294
     
    
    294 295
         ASSERT_WSDEQUE_INVARIANTS(pool);
    
    ... ... @@ -322,7 +323,8 @@ traverseSparkQueue (evac_fn evac, void *user, Capability *cap)
    322 323
         }
    
    323 324
     
    
    324 325
         debugTrace(DEBUG_sparks,
    
    325
    -               "traversed spark queue, len=%ld; (hd=%ld; tl=%ld)",
    
    326
    +               "traversed spark queue, len=%ld; "
    
    327
    +               "(hd=%" FMT_Int "; tl=%" FMT_Int ")",
    
    326 328
                    sparkPoolSize(pool), pool->bottom, pool->top);
    
    327 329
     }
    
    328 330
     
    

  • rts/StableName.c
    ... ... @@ -195,7 +195,7 @@ lookupStableName (StgPtr p)
    195 195
     
    
    196 196
       if (sn != 0) {
    
    197 197
         ASSERT(stable_name_table[sn].addr == p);
    
    198
    -    debugTrace(DEBUG_stable, "cached stable name %ld at %p",sn,p);
    
    198
    +    debugTrace(DEBUG_stable, "cached stable name %" FMT_Word " at %p", sn, p);
    
    199 199
         stableNameUnlock();
    
    200 200
         return sn;
    
    201 201
       }
    
    ... ... @@ -275,8 +275,8 @@ gcStableNameTable( void )
    275 275
                     p->sn_obj = isAlive(p->sn_obj);
    
    276 276
                     if (p->sn_obj == NULL) {
    
    277 277
                         // StableName object died
    
    278
    -                    debugTrace(DEBUG_stable, "GC'd StableName %ld (addr=%p)",
    
    279
    -                               (long)(p - stable_name_table), p->addr);
    
    278
    +                    debugTrace(DEBUG_stable, "GC'd StableName %td (addr=%p)",
    
    279
    +                               p - stable_name_table, p->addr);
    
    280 280
                         freeSnEntry(p);
    
    281 281
                     } else if (p->addr != NULL) {
    
    282 282
                         // sn_obj is alive, update pointee
    

  • rts/ThreadPaused.c
    ... ... @@ -315,8 +315,8 @@ threadPaused(Capability *cap, StgTSO *tso)
    315 315
                     || (bh_info == &stg_WHITEHOLE_info))
    
    316 316
                 {
    
    317 317
                     debugTrace(DEBUG_squeeze,
    
    318
    -                           "suspending duplicate work: %ld words of stack",
    
    319
    -                           (long)((StgPtr)frame - tso->stackobj->sp));
    
    318
    +                           "suspending duplicate work: %td words of stack",
    
    319
    +                           (StgPtr)frame - tso->stackobj->sp);
    
    320 320
     
    
    321 321
                     // If this closure is already an indirection, then
    
    322 322
                     // suspend the computation up to this point.
    

  • rts/Threads.c
    ... ... @@ -609,7 +609,7 @@ threadStackOverflow (Capability *cap, StgTSO *tso)
    609 609
     
    
    610 610
             debugTrace(DEBUG_gc,
    
    611 611
                        "threadStackOverflow of TSO %" FMT_StgThreadID " (%p): stack"
    
    612
    -                   " too large (now %ld; max is %ld)", tso->id, tso,
    
    612
    +                   " too large (now %ld; max is %u)", tso->id, tso,
    
    613 613
                        (long)tso->stackobj->stack_size, RtsFlags.GcFlags.maxStkSize);
    
    614 614
             IF_DEBUG(gc,
    
    615 615
                      /* If we're debugging, just print out the top of the stack */
    
    ... ... @@ -667,7 +667,7 @@ threadStackOverflow (Capability *cap, StgTSO *tso)
    667 667
         }
    
    668 668
     
    
    669 669
         debugTraceCap(DEBUG_sched, cap,
    
    670
    -                  "allocating new stack chunk of size %d bytes",
    
    670
    +                  "allocating new stack chunk of size %" FMT_Word " bytes",
    
    671 671
                       chunk_size * sizeof(W_));
    
    672 672
     
    
    673 673
         // Charge the current thread for allocating stack.  Stack usage is
    
    ... ... @@ -966,7 +966,8 @@ printThreadBlockage(StgTSO *tso)
    966 966
       switch (UntagWhyBlocked(ACQUIRE_LOAD(&tso->why_blocked))) {
    
    967 967
     #if defined(mingw32_HOST_OS)
    
    968 968
         case BlockedOnDoProc:
    
    969
    -    debugBelch("is blocked on proc (request: %" FMT_Word ")", tso->block_info.async_reqID);
    
    969
    +    debugBelch("is blocked on proc (request: %" FMT_Word ")",
    
    970
    +               tso->block_info.async_reqID);
    
    970 971
         break;
    
    971 972
     #endif
    
    972 973
     #if !defined(THREADED_RTS)
    

  • rts/Trace.h
    ... ... @@ -113,7 +113,7 @@ extern RUNTIME_TRACE_FLAG_CACHE RuntimeTraceFlagCache;
    113 113
     // -----------------------------------------------------------------------------
    
    114 114
     
    
    115 115
     #if defined(DEBUG)
    
    116
    -void traceBegin (const char *str, ...);
    
    116
    +void traceBegin (const char *str, ...) STG_PRINTF_ATTR(1, 2);
    
    117 117
     void traceEnd (void);
    
    118 118
     #endif
    
    119 119
     
    
    ... ... @@ -265,7 +265,8 @@ void traceSparkEvent_ (Capability *cap, EventTypeNum tag, StgWord info1);
    265 265
             traceCap_(cap, msg, ##__VA_ARGS__);     \
    
    266 266
         }
    
    267 267
     
    
    268
    -void traceCap_(Capability *cap, char *msg, ...);
    
    268
    +void traceCap_(Capability *cap, char *msg, ...)
    
    269
    +    STG_PRINTF_ATTR(2, 3);
    
    269 270
     
    
    270 271
     /*
    
    271 272
      * Emit a trace message
    
    ... ... @@ -275,7 +276,8 @@ void traceCap_(Capability *cap, char *msg, ...);
    275 276
             trace_(msg, ##__VA_ARGS__);             \
    
    276 277
         }
    
    277 278
     
    
    278
    -void trace_(char *msg, ...);
    
    279
    +void trace_(char *msg, ...)
    
    280
    +    STG_PRINTF_ATTR(1, 2);
    
    279 281
     
    
    280 282
     /*
    
    281 283
      * A message or event emitted by the program
    

  • rts/posix/Poll.c
    ... ... @@ -421,14 +421,14 @@ void pollCompletedTimeoutsOrIOPoll(CapIOManager *iomgr)
    421 421
             int res = ppoll(poll_table, nfds, &tv, NULL);
    
    422 422
     
    
    423 423
             debugTrace(DEBUG_iomanager,
    
    424
    -                   "ppoll(nfds = %d, timeout.sec = 0, timeout.nsec = 0) = %d",
    
    425
    -                   nfds, res);
    
    424
    +                   "ppoll(nfds = %lu, timeout.sec = 0, timeout.nsec = 0) = %d",
    
    425
    +                   (unsigned long) nfds, res);
    
    426 426
     #else
    
    427 427
             int res = poll(poll_table, nfds, 0);
    
    428 428
     
    
    429 429
             debugTrace(DEBUG_iomanager,
    
    430
    -                   "poll(nfds = %d, timeout_ms = 0) = %d",
    
    431
    -                   nfds, res);
    
    430
    +                   "poll(nfds = %lu, timeout_ms = 0) = %d",
    
    431
    +                   (unsigned long) nfds, res);
    
    432 432
     #endif
    
    433 433
             if (res == 0) {
    
    434 434
                 /* There is no I/O ready. We'll return to the scheduler. */
    
    ... ... @@ -502,15 +502,17 @@ bool awaitCompletedTimeoutsOrIOPoll(CapIOManager *iomgr)
    502 502
             int res = ppoll(poll_table, nfds, timeout_ns, NULL);
    
    503 503
     
    
    504 504
             debugTrace(DEBUG_iomanager,
    
    505
    -                   "ppoll(nfds = %d, timeout.sec = %d, timeout.nsec = %d) = %d",
    
    506
    -                   nfds, timeout_ns == NULL ? -1 : timeout_ns->tv_sec,
    
    507
    -                         timeout_ns == NULL ?  0 : timeout_ns->tv_nsec,
    
    505
    +                   "ppoll(nfds = %lu, timeout.sec = %lld, timeout.nsec = %lld)"
    
    506
    +                   " = %d",
    
    507
    +                   (unsigned long) nfds,
    
    508
    +                   (long long) (timeout_ns == NULL ? -1 : timeout_ns->tv_sec),
    
    509
    +                   (long long) (timeout_ns == NULL ?  0 : timeout_ns->tv_nsec),
    
    508 510
                        res);
    
    509 511
     #else
    
    510 512
             int res = poll(poll_table, nfds, timeout_ms);
    
    511 513
     
    
    512 514
             debugTrace(DEBUG_iomanager,
    
    513
    -                   "poll(nfds = %d, timeout_ms = %d) = %d",
    
    515
    +                   "poll(nfds = %lu, timeout_ms = %d) = %d",
    
    514 516
                        nfds, timeout_ms, res);
    
    515 517
     #endif
    
    516 518
     
    

  • rts/posix/Timeout.c
    ... ... @@ -54,7 +54,8 @@ bool syncDelayTimeout(CapIOManager *iomgr, StgTSO *tso, HsInt us_delay)
    54 54
         insertTimeoutQueue(&iomgr->timeout_queue, timeout, target);
    
    55 55
     
    
    56 56
         debugTrace(DEBUG_iomanager,
    
    57
    -               "timer for delay of %lld usec installed at time %lld ns",
    
    57
    +               "timer for delay of %" FMT_Int " usec installed "
    
    58
    +               "at time %" FMT_Int64 " ns",
    
    58 59
                    us_delay, target);
    
    59 60
         return true;
    
    60 61
     }
    
    ... ... @@ -98,7 +99,8 @@ void processTimeoutCompletions(CapIOManager *iomgr, Time now)
    98 99
             if (now < waketime) {
    
    99 100
                 break;
    
    100 101
             }
    
    101
    -        debugTrace(DEBUG_iomanager,"timer expired at %lld ns", waketime);
    
    102
    +        debugTrace(DEBUG_iomanager, "timer expired at %" FMT_Int64 " ns",
    
    103
    +                                    waketime);
    
    102 104
             StgTimeout *timeout;
    
    103 105
             deleteMinTimeoutQueue(&iomgr->timeout_queue, &timeout);
    
    104 106
             notifyTimeoutCompletion(iomgr, timeout);
    

  • rts/sm/Compact.c
    ... ... @@ -1049,7 +1049,7 @@ compact(StgClosure *static_objects,
    1049 1049
         // 2. update forward ptrs
    
    1050 1050
         for (W_ g = 0; g < RtsFlags.GcFlags.generations; g++) {
    
    1051 1051
             generation *gen = &generations[g];
    
    1052
    -        debugTrace(DEBUG_gc, "update_fwd:  %d", g);
    
    1052
    +        debugTrace(DEBUG_gc, "update_fwd:  %" FMT_Word, g);
    
    1053 1053
     
    
    1054 1054
             update_fwd(gen->blocks);
    
    1055 1055
             for (W_ n = 0; n < getNumCapabilities(); n++) {
    
    ... ... @@ -1059,7 +1059,7 @@ compact(StgClosure *static_objects,
    1059 1059
             update_fwd_large(gen->scavenged_large_objects);
    
    1060 1060
             update_fwd_cnf(gen->live_compact_objects);
    
    1061 1061
             if (g == RtsFlags.GcFlags.generations-1 && gen->old_blocks != NULL) {
    
    1062
    -            debugTrace(DEBUG_gc, "update_fwd:  %d (compact)", g);
    
    1062
    +            debugTrace(DEBUG_gc, "update_fwd:  %" FMT_Word " (compact)", g);
    
    1063 1063
                 update_fwd_compact(gen->old_blocks);
    
    1064 1064
             }
    
    1065 1065
         }
    
    ... ... @@ -1069,7 +1069,8 @@ compact(StgClosure *static_objects,
    1069 1069
         if (gen->old_blocks != NULL) {
    
    1070 1070
             W_ blocks = update_bkwd_compact(gen);
    
    1071 1071
             debugTrace(DEBUG_gc,
    
    1072
    -                   "update_bkwd: %d (compact, old: %d blocks, now %d blocks)",
    
    1072
    +                   "update_bkwd: %d (compact, old: %" FMT_Word " blocks, "
    
    1073
    +                                              "now %" FMT_Word " blocks)",
    
    1073 1074
                        gen->no, gen->n_old_blocks, blocks);
    
    1074 1075
             gen->n_old_blocks = blocks;
    
    1075 1076
         }
    

  • rts/sm/GC.c
    ... ... @@ -636,13 +636,13 @@ GarbageCollect (struct GcConfig config,
    636 636
                   if(idle_cap[i]) { continue; }
    
    637 637
                   thread = gc_threads[i];
    
    638 638
                   debugTrace(DEBUG_gc,"thread %d:", i);
    
    639
    -              debugTrace(DEBUG_gc,"   copied           %ld",
    
    639
    +              debugTrace(DEBUG_gc,"   copied           %" FMT_Word,
    
    640 640
                              RELAXED_LOAD(&thread->copied) * sizeof(W_));
    
    641
    -              debugTrace(DEBUG_gc,"   scanned          %ld",
    
    641
    +              debugTrace(DEBUG_gc,"   scanned          %" FMT_Word,
    
    642 642
                              RELAXED_LOAD(&thread->scanned) * sizeof(W_));
    
    643
    -              debugTrace(DEBUG_gc,"   any_work         %ld",
    
    643
    +              debugTrace(DEBUG_gc,"   any_work         %" FMT_Word,
    
    644 644
                              RELAXED_LOAD(&thread->any_work));
    
    645
    -              debugTrace(DEBUG_gc,"   scav_find_work %ld",
    
    645
    +              debugTrace(DEBUG_gc,"   scav_find_work   %" FMT_Word ,
    
    646 646
                              RELAXED_LOAD(&thread->scav_find_work));
    
    647 647
     
    
    648 648
                   any_work += RELAXED_LOAD(&thread->any_work);
    
    ... ... @@ -694,7 +694,15 @@ GarbageCollect (struct GcConfig config,
    694 694
     
    
    695 695
     #if defined(DEBUG)
    
    696 696
             debugTrace(DEBUG_gc,
    
    697
    -                   "mut_list_size: %lu (%d vars, %d arrays, %d MVARs, %d TVARs, %d TVAR_WATCH_QUEUEs, %d TREC_CHUNKs, %d TREC_HEADERs, %d others)",
    
    697
    +                   "mut_list_size: %lu ("
    
    698
    +                   "%" FMT_Word " vars, "
    
    699
    +                   "%" FMT_Word " arrays, "
    
    700
    +                   "%" FMT_Word " MVARs, "
    
    701
    +                   "%" FMT_Word " TVARs, "
    
    702
    +                   "%" FMT_Word " TVAR_WATCH_QUEUEs, "
    
    703
    +                   "%" FMT_Word " TREC_CHUNKs, "
    
    704
    +                   "%" FMT_Word " TREC_HEADERs, "
    
    705
    +                   "%" FMT_Word " others)",
    
    698 706
                        (unsigned long)(mut_list_size * sizeof(W_)),
    
    699 707
                        mutlist_scav_stats.n_MUTVAR,
    
    700 708
                        mutlist_scav_stats.n_MUTARR,
    
    ... ... @@ -914,7 +922,7 @@ GarbageCollect (struct GcConfig config,
    914 922
     
    
    915 923
       // Free the mark stack.
    
    916 924
       if (mark_stack_top_bd != NULL) {
    
    917
    -      debugTrace(DEBUG_gc, "mark stack: %d blocks",
    
    925
    +      debugTrace(DEBUG_gc, "mark stack: %" FMT_Word " blocks",
    
    918 926
                      countBlocks(mark_stack_top_bd));
    
    919 927
           freeChain(mark_stack_top_bd);
    
    920 928
       }
    
    ... ... @@ -1018,7 +1026,9 @@ GarbageCollect (struct GcConfig config,
    1018 1026
           need_copied_live = BLOCK_ROUND_UP(need_copied_live) / BLOCK_SIZE_W;
    
    1019 1027
           need_uncopied_live = BLOCK_ROUND_UP(need_uncopied_live) / BLOCK_SIZE_W;
    
    1020 1028
     
    
    1021
    -      debugTrace(DEBUG_gc, "(before) copied_live: %d; uncopied_live: %d", need_copied_live, need_uncopied_live );
    
    1029
    +      debugTrace(DEBUG_gc, "(before) copied_live: %" FMT_Word "; "
    
    1030
    +                           "uncopied_live: %" FMT_Word,
    
    1031
    +                           need_copied_live, need_uncopied_live);
    
    1022 1032
     
    
    1023 1033
     
    
    1024 1034
           // minOldGenSize states that the size of the oldest generation must be at least
    
    ... ... @@ -1027,7 +1037,8 @@ GarbageCollect (struct GcConfig config,
    1027 1037
           if (RtsFlags.GcFlags.minOldGenSize >= need_copied_live + need_uncopied_live){
    
    1028 1038
             extra_needed = RtsFlags.GcFlags.minOldGenSize - (need_copied_live + need_uncopied_live);
    
    1029 1039
           }
    
    1030
    -      debugTrace(DEBUG_gc, "(minOldGen: %d; extra_needed: %d", RtsFlags.GcFlags.minOldGenSize, extra_needed);
    
    1040
    +      debugTrace(DEBUG_gc, "(minOldGen: %d; extra_needed: %" FMT_Word,
    
    1041
    +                           RtsFlags.GcFlags.minOldGenSize, extra_needed);
    
    1031 1042
     
    
    1032 1043
           // If oldest gen is uncopying in some manner (compact or non-moving) then
    
    1033 1044
           // add the extra requested by minOldGenSize to uncopying portion of memory.
    
    ... ... @@ -1041,7 +1052,9 @@ GarbageCollect (struct GcConfig config,
    1041 1052
     
    
    1042 1053
           ASSERT(need_uncopied_live + need_copied_live >= RtsFlags.GcFlags.minOldGenSize );
    
    1043 1054
     
    
    1044
    -      debugTrace(DEBUG_gc, "(after) copied_live: %d; uncopied_live: %d", need_copied_live, need_uncopied_live );
    
    1055
    +      debugTrace(DEBUG_gc, "(after) copied_live: %" FMT_Word "; "
    
    1056
    +                           "uncopied_live: %" FMT_Word,
    
    1057
    +                           need_copied_live, need_uncopied_live);
    
    1045 1058
     
    
    1046 1059
           need_prealloc = 0;
    
    1047 1060
           for (i = 0; i < n_nurseries; i++) {
    
    ... ... @@ -1098,7 +1111,7 @@ GarbageCollect (struct GcConfig config,
    1098 1111
           need = BLOCKS_TO_MBLOCKS(need);
    
    1099 1112
     
    
    1100 1113
           got = mblocks_allocated;
    
    1101
    -      debugTrace(DEBUG_gc,"Returning: %d %d", got, need);
    
    1114
    +      debugTrace(DEBUG_gc, "Returning: %" FMT_Word " %" FMT_Word, got, need);
    
    1102 1115
     
    
    1103 1116
           uint32_t returned = 0;
    
    1104 1117
           if (got > need) {
    
    ... ... @@ -1772,7 +1785,7 @@ prepare_collected_gen (generation *gen)
    1772 1785
                 gen->bitmap = bitmap_bdescr;
    
    1773 1786
                 bitmap = bitmap_bdescr->start;
    
    1774 1787
     
    
    1775
    -            debugTrace(DEBUG_gc, "bitmap_size: %d, bitmap: %p",
    
    1788
    +            debugTrace(DEBUG_gc, "bitmap_size: %" FMT_Word ", bitmap: %p",
    
    1776 1789
                            bitmap_size, bitmap);
    
    1777 1790
     
    
    1778 1791
                 // don't forget to fill it with zeros!
    
    ... ... @@ -2109,7 +2122,8 @@ resize_nursery (void)
    2109 2122
     
    
    2110 2123
                 adjusted_blocks = (RtsFlags.GcFlags.maxHeapSize - 2 * blocks);
    
    2111 2124
     
    
    2112
    -            debugTrace(DEBUG_gc, "near maximum heap size of 0x%x blocks, blocks = %d, adjusted to %ld",
    
    2125
    +            debugTrace(DEBUG_gc, "near maximum heap size of 0x%x blocks, "
    
    2126
    +                                 "blocks = %" FMT_Word ", adjusted to %ld",
    
    2113 2127
                            RtsFlags.GcFlags.maxHeapSize, blocks, adjusted_blocks);
    
    2114 2128
     
    
    2115 2129
                 pc_free = adjusted_blocks * 100 / RtsFlags.GcFlags.maxHeapSize;
    

  • rts/sm/GCUtils.c
    ... ... @@ -173,9 +173,10 @@ push_scanned_block (bdescr *bd, gen_workspace *ws)
    173 173
     void
    
    174 174
     push_todo_block(bdescr *bd, gen_workspace *ws)
    
    175 175
     {
    
    176
    -    debugTrace(DEBUG_gc, "push todo block %p (%ld words), step %d, todo_q: %ld",
    
    177
    -            bd->start, (unsigned long)(bd->free - bd->u.scan),
    
    178
    -            ws->gen->no, dequeElements(ws->todo_q));
    
    176
    +    debugTrace(DEBUG_gc, "push todo block %p (%ld words), step %d, "
    
    177
    +                         "todo_q: %" FMT_Int,
    
    178
    +               bd->start, (unsigned long)(bd->free - bd->u.scan),
    
    179
    +               ws->gen->no, dequeElements(ws->todo_q));
    
    179 180
     
    
    180 181
         ASSERT(bd->link == NULL);
    
    181 182
     
    

  • rts/sm/MBlock.c
    ... ... @@ -398,7 +398,8 @@ void releaseFreeMemory(void)
    398 398
         // Do nothing if USE_LARGE_ADDRESS_SPACE, we never want
    
    399 399
         // to release address space
    
    400 400
     
    
    401
    -    debugTrace(DEBUG_gc, "mblock_high_watermark: %p\n", mblock_high_watermark);
    
    401
    +    debugTrace(DEBUG_gc, "mblock_high_watermark: %p\n",
    
    402
    +                         (void*)mblock_high_watermark);
    
    402 403
     }
    
    403 404
     
    
    404 405
     #else // !USE_LARGE_ADDRESS_SPACE
    

  • rts/sm/NonMoving.c
    ... ... @@ -707,7 +707,7 @@ void nonmovingPruneFreeSegmentList(void)
    707 707
       oldest_gen->n_words  -= pruned_segments * NONMOVING_SEGMENT_SIZE;
    
    708 708
       nonmovingHeap.saved_free = NULL;
    
    709 709
       debugTrace(DEBUG_nonmoving_gc,
    
    710
    -            "Pruned %d free segments, leaving %d on the free segment list.",
    
    710
    +            "Pruned %zd free segments, leaving %zd on the free segment list.",
    
    711 711
                 pruned_segments, new_length);
    
    712 712
       traceNonmovingPrunedSegments(pruned_segments, new_length);
    
    713 713
       trace(TRACE_nonmoving_gc, "Finished pruning free segment list.");
    

  • rts/sm/NonMovingMark.c
    ... ... @@ -370,7 +370,8 @@ void nonmovingBeginFlush(Task *task)
    370 370
     bool nonmovingWaitForFlush(void)
    
    371 371
     {
    
    372 372
         ACQUIRE_LOCK(&upd_rem_set_lock);
    
    373
    -    debugTrace(DEBUG_nonmoving_gc, "Flush count %d", upd_rem_set_flush_count);
    
    373
    +    debugTrace(DEBUG_nonmoving_gc, "Flush count %" FMT_Word,
    
    374
    +                                   upd_rem_set_flush_count);
    
    374 375
         bool finished = upd_rem_set_flush_count == getNumCapabilities();
    
    375 376
         if (!finished) {
    
    376 377
             waitCondition(&upd_rem_set_flushed_cond, &upd_rem_set_lock);
    
    ... ... @@ -1872,7 +1873,8 @@ nonmovingMark (MarkBudget* budget, MarkQueue *queue)
    1872 1873
                     RELEASE_SM_LOCK;
    
    1873 1874
                 } else {
    
    1874 1875
                     // Nothing more to do
    
    1875
    -                debugTrace(DEBUG_nonmoving_gc, "Finished mark pass: %d", count);
    
    1876
    +                debugTrace(DEBUG_nonmoving_gc,
    
    1877
    +                           "Finished mark pass: %" FMT_Word64, count);
    
    1876 1878
                     traceConcMarkEnd(count);
    
    1877 1879
                     return;
    
    1878 1880
                 }
    

  • rts/sm/Storage.c
    ... ... @@ -874,7 +874,8 @@ resizeNurseriesEach (W_ blocks)
    874 874
     
    
    875 875
             node = capNoToNumaNode(i);
    
    876 876
             if (nursery_blocks < blocks) {
    
    877
    -            debugTrace(DEBUG_gc, "increasing size of nursery from %d to %d blocks",
    
    877
    +            debugTrace(DEBUG_gc, "increasing size of nursery from %" FMT_Word
    
    878
    +                                 " to %" FMT_Word " blocks",
    
    878 879
                            nursery_blocks, blocks);
    
    879 880
                 nursery->blocks = allocNursery(node, nursery->blocks,
    
    880 881
                                                blocks-nursery_blocks);
    
    ... ... @@ -883,7 +884,8 @@ resizeNurseriesEach (W_ blocks)
    883 884
             {
    
    884 885
                 bdescr *next_bd;
    
    885 886
     
    
    886
    -            debugTrace(DEBUG_gc, "decreasing size of nursery from %d to %d blocks",
    
    887
    +            debugTrace(DEBUG_gc, "decreasing size of nursery from %" FMT_Word
    
    888
    +                                 " to %" FMT_Word " blocks",
    
    887 889
                            nursery_blocks, blocks);
    
    888 890
     
    
    889 891
                 bd = nursery->blocks;
    
    ... ... @@ -898,7 +900,8 @@ resizeNurseriesEach (W_ blocks)
    898 900
                 // might have gone just under, by freeing a large block, so make
    
    899 901
                 // up the difference.
    
    900 902
                 if (nursery_blocks < blocks) {
    
    901
    -                debugTrace(DEBUG_gc, "reincreasing size of nursery from %d to %d blocks",
    
    903
    +                debugTrace(DEBUG_gc, "reincreasing size of nursery from"
    
    904
    +                                     " %" FMT_Word " to %" FMT_Word " blocks",
    
    902 905
                                  nursery_blocks, blocks);
    
    903 906
                     nursery->blocks = allocNursery(node, nursery->blocks,
    
    904 907
                                                    blocks-nursery_blocks);
    

  • rts/sm/Sweep.c
    ... ... @@ -74,7 +74,11 @@ sweep(generation *gen)
    74 74
     
    
    75 75
         gen->live_estimate = live;
    
    76 76
     
    
    77
    -    debugTrace(DEBUG_gc, "sweeping: %d blocks, %d were copied, %d freed (%d%%), %d are fragmented, live estimate: %ld%%",
    
    77
    +    debugTrace(DEBUG_gc, "sweeping: %" FMT_Word " blocks, "
    
    78
    +                                   "%" FMT_Word " were copied, "
    
    79
    +                                   "%" FMT_Word " freed (%" FMT_Word "%%), "
    
    80
    +                                   "%" FMT_Word " are fragmented, "
    
    81
    +                         "live estimate: %lu%%",
    
    78 82
               gen->n_old_blocks + freed,
    
    79 83
               gen->n_old_blocks - blocks + freed,
    
    80 84
               freed,
    

  • testsuite/tests/codeGen/should_run/all.T
    ... ... @@ -258,7 +258,7 @@ test('T24893', normal, compile_and_run, ['-O'])
    258 258
     test('CCallConv', [req_c], compile_and_run, ['CCallConv_c.c'])
    
    259 259
     test('T25364', normal, compile_and_run, [''])
    
    260 260
     test('T26061', normal, compile_and_run, [''])
    
    261
    -test('T26537', normal, compile_and_run, ['-O2 -fregs-graph'])
    
    261
    +test('T26537', compile_timeout_multiplier(1.5), compile_and_run, ['-O2 -fregs-graph'])
    
    262 262
     test('T24016', normal, compile_and_run, ['-O1 -fPIC'])
    
    263 263
     test('T27046',
    
    264 264
          [ req_cmm
    

  • utils/check-exact/ExactPrint.hs
    ... ... @@ -370,10 +370,6 @@ cua CanUpdateAnchor f = f
    370 370
     cua CanUpdateAnchorOnly _ = return []
    
    371 371
     cua NoCanUpdateAnchor _ = return []
    
    372 372
     
    
    373
    -enterAnn :: (Monad m, Monoid w, ExactPrint a) => Entry -> a -> EP w m a
    
    374
    -enterAnn = enterAnnWith exact setAnnotationAnchor
    
    375
    -
    
    376
    -{-# INLINE enterAnnWith #-}
    
    377 373
     -- | "Enter" an annotation, by using the associated 'anchor' field as
    
    378 374
     -- the new reference point for calculating all DeltaPos positions.
    
    379 375
     -- This is the heart of the exact printing process.
    
    ... ... @@ -381,17 +377,14 @@ enterAnn = enterAnnWith exact setAnnotationAnchor
    381 377
     -- This is combination of the ghc=exactprint Delta.withAST and
    
    382 378
     -- Print.exactPC functions and effectively does the delta processing
    
    383 379
     -- immediately followed by the print processing.  JIT ghc-exactprint.
    
    384
    -enterAnnWith :: (Monad m, Monoid w, Typeable a, Typeable b) =>
    
    385
    -  (a -> EP w m b) -> -- exact
    
    386
    -  (b -> EpaLocation -> [TrailingAnn] -> EpAnnComments -> b) -> -- setAnnotationAnchor
    
    387
    -  Entry -> a -> EP w m b
    
    388
    -enterAnnWith exactVia _ NoEntryVal a = do
    
    380
    +enterAnn :: (Monad m, Monoid w, ExactPrint a) => Entry -> a -> EP w m a
    
    381
    +enterAnn NoEntryVal a = do
    
    389 382
       p <- getPosP
    
    390 383
       debugM $ "enterAnn:starting:NO ANN:(p,a) =" ++ show (p, astId a)
    
    391
    -  r <- exactVia a
    
    384
    +  r <- exact a
    
    392 385
       debugM $ "enterAnn:done:NO ANN:p =" ++ show (p, astId a)
    
    393 386
       return r
    
    394
    -enterAnnWith exactVia setAnnAnchor !(Entry anchor' trailing_anns cs flush canUpdateAnchor) a = do
    
    387
    +enterAnn !(Entry anchor' trailing_anns cs flush canUpdateAnchor) a = do
    
    395 388
       acceptSpan <- getAcceptSpan
    
    396 389
       setAcceptSpan False
    
    397 390
       case anchor' of
    
    ... ... @@ -502,7 +495,7 @@ enterAnnWith exactVia setAnnAnchor !(Entry anchor' trailing_anns cs flush canUpd
    502 495
     
    
    503 496
       advance edp
    
    504 497
       debugM $ "enterAnn:exact a starting:" ++ show (showAst anchor')
    
    505
    -  a' <- exactVia a
    
    498
    +  a' <- exact a
    
    506 499
       debugM $ "enterAnn:exact a done:" ++ show (showAst anchor')
    
    507 500
     
    
    508 501
       -- Core recursive exactprint done, start end of Entry processing
    
    ... ... @@ -556,8 +549,8 @@ enterAnnWith exactVia setAnnAnchor !(Entry anchor' trailing_anns cs flush canUpd
    556 549
               EpaSpan s -> EpaDelta s         edp []
    
    557 550
               _         -> EpaDelta noSrcSpan edp []
    
    558 551
       let r = case canUpdateAnchor of
    
    559
    -            CanUpdateAnchor -> setAnnAnchor a' newAnchor trailing' (mkEpaComments priorCs postCs)
    
    560
    -            CanUpdateAnchorOnly -> setAnnAnchor a' newAnchor [] emptyComments
    
    552
    +            CanUpdateAnchor -> setAnnotationAnchor a' newAnchor trailing' (mkEpaComments priorCs postCs)
    
    553
    +            CanUpdateAnchorOnly -> setAnnotationAnchor a' newAnchor [] emptyComments
    
    561 554
                 NoCanUpdateAnchor -> a'
    
    562 555
       return r
    
    563 556
     
    
    ... ... @@ -4264,26 +4257,13 @@ instance ExactPrint (ConDecl GhcPs) where
    4264 4257
         epTokensToComments "(" ops
    
    4265 4258
         epTokensToComments ")" cps
    
    4266 4259
     
    
    4267
    -    -- Work around https://gitlab.haskell.org/ghc/ghc/-/issues/20558
    
    4268 4260
         outer_bndrs' <- case outer_bndrs of
    
    4269 4261
           L _ (HsOuterImplicit _) -> return outer_bndrs
    
    4270 4262
           _ -> markAnnotated outer_bndrs
    
    4271 4263
     
    
    4272
    -    (inner_bndrs', (mcxt', args', res_ty')) <- markGadtArgs inner_bndrs $ do
    
    4273
    -      mcxt' <- markAnnotated mcxt
    
    4274
    -      args' <-
    
    4275
    -        case args of
    
    4276
    -            (PrefixConGADT x args0) -> do
    
    4277
    -              args0' <- mapM markAnnotated args0
    
    4278
    -              return (PrefixConGADT x args0')
    
    4279
    -            (RecConGADT (oc,cc,rarr) fields) -> do
    
    4280
    -              oc' <- markEpToken oc
    
    4281
    -              fields' <- markAnnotated fields
    
    4282
    -              cc' <- markEpToken cc
    
    4283
    -              rarr' <- markEpUniToken rarr
    
    4284
    -              return (RecConGADT (oc',cc',rarr') fields')
    
    4285
    -      res_ty' <- markAnnotated res_ty
    
    4286
    -      return (mcxt', args', res_ty')
    
    4264
    +    let ib = toInnerBindings inner_bndrs (mcxt, args, res_ty)
    
    4265
    +    ib' <- markAnnotated ib
    
    4266
    +    let (inner_bndrs', (mcxt', args', res_ty')) = fromInnerBindings ib'
    
    4287 4267
     
    
    4288 4268
         return (ConDeclGADT { con_g_ext = AnnConDeclGADT [] [] dcol'
    
    4289 4269
                             , con_names = cons'
    
    ... ... @@ -4293,43 +4273,54 @@ instance ExactPrint (ConDecl GhcPs) where
    4293 4273
                             , con_modifiers = mods'
    
    4294 4274
                             , con_res_ty = res_ty', con_doc = doc })
    
    4295 4275
     
    
    4296
    --- | Exact print the inner binders of a GADT signature.
    
    4297
    ---
    
    4298
    --- It's that complicated because we need to mark comments/trailing anns
    
    4299
    --- stored inside `L` and mark closing parenthesis _after_ we mark inner
    
    4300
    --- type:
    
    4301
    ---
    
    4302
    ---   data T a b where
    
    4303
    ---    MkT ::
    
    4304
    ---      forall a. ( -- mark inside `markGadtArgs`
    
    4305
    ---          forall b. some type -> T a b -- mark everything there
    
    4306
    ---        ) -- mark inside `markGadtArgs`
    
    4307
    ---
    
    4308
    --- We don't have the same problem for `HsArgPar` because we ignore it
    
    4309
    --- during exact-print, "Does not appear in original source"
    
    4310
    -markGadtArgs :: (Monad m, Monoid w, Typeable a)
    
    4311
    -             => [LHsGadtTelescope GhcPs] -> EP w m a
    
    4312
    -             -> EP w m ([LHsGadtTelescope GhcPs], a)
    
    4313
    -markGadtArgs args inner_action = go args
    
    4276
    +-- ---------------------------------------------------------------------
    
    4277
    +
    
    4278
    +data InnerBindings
    
    4279
    +  = InnerMore (LHsGadtTelescope GhcPs) InnerBindings
    
    4280
    +  | InnerDone (Maybe (LHsContext GhcPs), HsConDeclGADTDetails GhcPs, LHsType GhcPs)
    
    4281
    +
    
    4282
    +toInnerBindings :: [LHsGadtTelescope GhcPs]
    
    4283
    +                -> (Maybe (LHsContext GhcPs), HsConDeclGADTDetails GhcPs, LHsType GhcPs) -> InnerBindings
    
    4284
    +toInnerBindings [] inner = InnerDone inner
    
    4285
    +toInnerBindings (b:bs) inner = InnerMore b (toInnerBindings bs inner)
    
    4286
    +
    
    4287
    +fromInnerBindings :: InnerBindings -> ([LHsGadtTelescope GhcPs], (Maybe (LHsContext GhcPs), HsConDeclGADTDetails GhcPs, LHsType GhcPs))
    
    4288
    +fromInnerBindings = go []
    
    4314 4289
       where
    
    4315
    -    go [] = do
    
    4316
    -      r <- inner_action
    
    4317
    -      return ([], r)
    
    4318
    -    go (arg:xs) = enterAnnWith (exact_arg xs) setAnchor (entryFromLocatedA arg) arg
    
    4319
    -
    
    4320
    -    exact_arg xs (L l (HsGadtForAll _ tele)) = do
    
    4321
    -      tele' <- markAnnotated tele
    
    4322
    -      (xs', r) <- go xs
    
    4323
    -      return (L l (HsGadtForAll noExtField tele') : xs', r)
    
    4324
    -    exact_arg xs (L l (HsGadtPar (lp, rp))) = do
    
    4325
    -      lp' <- markEpToken lp
    
    4326
    -      (xs', r) <- go xs
    
    4327
    -      rp' <- markEpToken rp
    
    4328
    -      return (L l (HsGadtPar (lp',rp')) : xs', r)
    
    4329
    -
    
    4330
    -    -- The binder just entered is the head of the returned list
    
    4331
    -    setAnchor (arg':xs', r) anc ts cs = (setAnchorAn arg' anc ts cs : xs', r)
    
    4332
    -    setAnchor ([], r)       _   _  _  = ([], r)
    
    4290
    +    go acc (InnerMore b n) = go (b:acc) n
    
    4291
    +    go acc (InnerDone x) = (acc,x)
    
    4292
    +
    
    4293
    +instance ExactPrint InnerBindings where
    
    4294
    +  getAnnotationEntry (InnerMore (L li _) _) = fromAnn li
    
    4295
    +  getAnnotationEntry (InnerDone _)          = NoEntryVal
    
    4296
    +
    
    4297
    +  setAnnotationAnchor (InnerMore li n) anc ts cs = InnerMore (setAnchorAn li anc ts cs) n
    
    4298
    +  setAnnotationAnchor (InnerDone x) _ _ _ = InnerDone x
    
    4299
    +
    
    4300
    +  exact (InnerMore (L li (HsGadtForAll x tele)) n) = do
    
    4301
    +    tele' <- markAnnotated tele
    
    4302
    +    n' <- markAnnotated n
    
    4303
    +    return (InnerMore (L li (HsGadtForAll x tele')) n')
    
    4304
    +  exact  (InnerMore (L l (HsGadtPar (lp, rp))) xs) = do
    
    4305
    +    lp' <- markEpToken lp
    
    4306
    +    xs' <- markAnnotated xs
    
    4307
    +    rp' <- markEpToken rp
    
    4308
    +    return (InnerMore (L l (HsGadtPar (lp',rp'))) xs')
    
    4309
    +  exact (InnerDone (mcxt, args, res_ty)) = do
    
    4310
    +    mcxt' <- markAnnotated mcxt
    
    4311
    +    args' <-
    
    4312
    +      case args of
    
    4313
    +          (PrefixConGADT x args0) -> do
    
    4314
    +            args0' <- mapM markAnnotated args0
    
    4315
    +            return (PrefixConGADT x args0')
    
    4316
    +          (RecConGADT (oc,cc,rarr) fields) -> do
    
    4317
    +            oc' <- markEpToken oc
    
    4318
    +            fields' <- markAnnotated fields
    
    4319
    +            cc' <- markEpToken cc
    
    4320
    +            rarr' <- markEpUniToken rarr
    
    4321
    +            return (RecConGADT (oc',cc',rarr') fields')
    
    4322
    +    res_ty' <- markAnnotated res_ty
    
    4323
    +    return (InnerDone (mcxt', args', res_ty'))
    
    4333 4324
     
    
    4334 4325
     -- ---------------------------------------------------------------------
    
    4335 4326