let funname(c) = (((forgettype(c) sub 1) sub 1) sub 1):string;

let outputcurrentframe(s) =
    let func = CurrentFrame(s)
     in (outtok(`Currently executing function `);
         outtok(funname(func));
         newline(1));

let outputreturnstack(s) =
    let retstk = ReturnStack(s)
     in RhtReduceArray (\e. \x.(outtok(`which was called from `);
                                outtok(funname(e)); newline(1)))
                       retstk ();

let outputtrapstack(s) =
    let trapstk = TrapStack(s)
     in RhtReduceArray (\(l,c). \x.
                        (if null l
                         then (outtok(`A trap of everything established in `);
                               outtok(funname(c)); 
                               newline(1))
                         else (outtok(`[`);
                               listprint(l,outtok,`;`);
                               outtok(`] established in `);
                               outtok(funname(c)); 
                               newline(1))))
                       trapstk ();

let debugprocess(s) =
    (outputcurrentframe(s);
     Do(outputreturnstack(s)); newline(1);
     outtok(`The following traps are currently active:`); newline(1);
     Do(outputtrapstack(s));
     ());

syntax nonfix StoreAllocated 144 0; %RJG was 137!!!%
let rec StoreAllocated():int array = StoreAllocated();

let PrintStoreUsed(stused) =
   let rec printel(i,namelist,lc) =
   (if (stused sub i) > 0 
    then (if lc = 4 then newline(1)
          else if lc > 0 then outtok(`, `)
          else ();
          outtok(hd(namelist)); 
          printint(stused sub i);
          if null(tl(namelist)) then newline(1)
          else printel(i+1, tl(namelist), ((lc mod 4) + 1)))
    else (if null(tl(namelist)) then newline(1)
          else printel(i+1, tl(namelist), lc))
   ) in
   (outtok(`Store used (in bytes):`); newline(1);
    printel(1,
            [`States `; `Processes `; `Rec(1) `; `Rec(2) `; `Rec(N) `;
             `Tokens/Numbers `; `Variants `; `Bytecodes `;
             `ArgStacks `; `RetStacks `; `TrapStacks `],
            0)
   );     

let subtract(s,s') =
    let {l = LengthArray(s)
    enc  s'' = array(l,0)}
     in (update(s'', 1, ((s' sub 1) - (s sub 1)));
         update(s'', 2, ((s' sub 2) - (s sub 2)));
         update(s'', 3, ((s' sub 3) - (s sub 3)));
         % we must subtract 48 from the next total to remove this array from
           the count %
         update(s'', 4, ((s' sub 4) - (s sub 4) - 48));
         update(s'', 5, ((s' sub 5) - (s sub 5)));
         update(s'', 6, ((s' sub 6) - (s sub 6)));
         update(s'', 7, ((s' sub 7) - (s sub 7)));
         update(s'', 8, ((s' sub 8) - (s sub 8)));
         update(s'', 9, ((s' sub 9) - (s sub 9)));
         update(s'', 10, ((s' sub 10) - (s sub 10)));
         update(s'', 11, ((s' sub 11) - (s sub 11)));
         s'');
          
let TraceSpace(f) =
   \x. (let {s = StoreAllocated()
        enc  res = f(x)
        enc  s' = StoreAllocated()
        enc  s'' = subtract(s,s') }
         in  (PrintStoreUsed(s'');
              res));

syntax nonfix CopyClosure 138 1;
let rec CopyClosure(c:('a -> 'b)):('a -> 'b) = CopyClosure(c);
syntax nonfix ReplaceClosure 139 2;
let rec ReplaceClosure(c:('a -> 'b),c':('a -> 'b)):. = ReplaceClosure(c,c');
syntax nonfix EqualClosure 127 2;
let rec EqualClosure(c:('a -> 'b),c':('a -> 'b)):bool = EqualClosure(c,c');

syntax nonfix FastEntryPoint 142 1;
let rec FastEntryPoint(f: 'a -> 'b): (int # ('a -> 'b)) 
    = FastEntryPoint(f);
syntax nonfix FixUpClosure 141 2;
let rec FixUpClosure(bindsize:int, c:('a -> 'b)):('a -> 'b)
    = FixUpClosure(bindsize,c);
