-- BBBugOutImpl.mesa
-- Russ Atkinson, August 18, 1982 12:33 pm

DIRECTORY
  AtomsPrivate USING [AtomRec],
  BBBugOut USING [],
  Convert USING [MapValue],
  PPOps USING [ParseStream], 
  PrintTV USING [NullPutClosure, Print, PrintType, PutClosure, PutProc],
  Rope USING [Map, ROPE],
  RTBasic USING [TV, Type];

BBBugOutImpl: CEDAR MONITOR
   IMPORTS Convert, PPOps, PrintTV, Rope
   EXPORTS BBBugOut
   = BEGIN OPEN BBBugOut, PrintTV, Rope, RTBasic;

  Intercepted: CONDITION;
  defaultPut: PutClosure _ NullPutClosure;

  defaultWidth: NAT _ 32;          -- default width for ShowTV
  defaultDepth: NAT _ 2;           -- default depth for ShowTV
  debugParseAndPrint: BOOL _ FALSE; 

  -- use this routine to acquire the default closure
  -- we do not return unless there has been an interception  

  GetClosure: PUBLIC ENTRY PROC RETURNS [PutClosure] = {
    ENABLE UNWIND => NULL;
    WHILE defaultPut = NullPutClosure DO
       WAIT Intercepted;
       ENDLOOP;
    RETURN [defaultPut];
    };
  
  -- Intercept Routines exported to BBBugOut
 
  GetDefaultPut: PUBLIC ENTRY PROC RETURNS [put: PutClosure] = {
    ENABLE UNWIND => NULL;
    put _ defaultPut;
    }; 
  
  SetDefaultPut: PUBLIC ENTRY PROC
       [put: PutClosure _ NullPutClosure]
       RETURNS [oldPut: PutClosure] = {
    ENABLE UNWIND => NULL;
    oldPut _ defaultPut; 
    defaultPut _ put;
    BROADCAST Intercepted;
    }; 
  
  -- Output Routines exported to BBBugOut

  ShowChar: PUBLIC PROC [c: CHAR, put: PutClosure _ NullPutClosure] = {
    IF put = NullPutClosure THEN put _ GetClosure[];
    put.proc[put.data, c];
    }; 
  
  ShowCR: PUBLIC PROC [put: PutClosure _ NullPutClosure] = {
    IF put = NullPutClosure THEN put _ GetClosure[];
    put.proc[put.data, '\n];
    }; 
  
  ShowDecimal: PUBLIC PROC [x: INT, put: PutClosure _ NullPutClosure] = {
    put1: PROC [c: CHAR] = {put.proc[put.data, c]};
    IF put = NullPutClosure THEN put _ GetClosure[];
    IF x IN [0..10) THEN
       {small: [0..10) _ x;
        [] _ put1['0 + small];
        RETURN;
        };
    Convert.MapValue[put1, [signed[x, 10]]]
    }; 
  
  ShowOctal: PUBLIC PROC [x: INT, put: PutClosure _ NullPutClosure] = {
    put1: PROC [c: CHAR] = {put.proc[put.data, c]};
    IF put = NullPutClosure THEN put _ GetClosure[];
    IF x IN [0..8) THEN
       {small: [0..8) _ x;
        [] _ put1['0 + small];
        RETURN;
        };
    Convert.MapValue[put1, [unsigned[LOOPHOLE[x, LONG CARDINAL], 8]]]
    }; 
  
  ShowRope: PUBLIC PROC [r: ROPE _ NIL, put: PutClosure _ NullPutClosure] = {
    put1: PROC [c: CHAR] RETURNS [BOOL] = {put.proc[put.data, c]; RETURN [FALSE]};
    IF put = NullPutClosure THEN put _ GetClosure[];
    [] _ Rope.Map[base: r, action: put1]
    }; 
  
  ShowRopes: PUBLIC PROC [r1,r2,r3,r4: ROPE _ NIL, put: PutClosure _ NullPutClosure] = {
    put1: PROC [c: CHAR] RETURNS [BOOL] = {put.proc[put.data, c]; RETURN [FALSE]};
    IF put = NullPutClosure THEN put _ GetClosure[];
    IF r1 # NIL THEN [] _ Rope.Map[base: r1, action: put1];
    IF r2 # NIL THEN [] _ Rope.Map[base: r2, action: put1];
    IF r3 # NIL THEN [] _ Rope.Map[base: r3, action: put1];
    IF r4 # NIL THEN [] _ Rope.Map[base: r4, action: put1];
    }; 
  
  ShowLine: PUBLIC PROC [r: ROPE _ NIL, put: PutClosure _ NullPutClosure] = {
    put1: PROC [c: CHAR] RETURNS [BOOL] = {put.proc[put.data, c]; RETURN [FALSE]};
    IF put = NullPutClosure THEN put _ GetClosure[];
    [] _ Rope.Map[base: r, action: put1];
    [] _ put1[15C]
    }; 
  
  ShowAtom: PUBLIC PROC [atom: ATOM, put: PutClosure _ NullPutClosure] = TRUSTED {
    IF atom # NIL THEN
       {patom: REF AtomsPrivate.AtomRec = LOOPHOLE[atom]; 
        ShowRope[patom.pName, put]};
    }; 
  
  ShowTV: PUBLIC PROC
      [tv: TV, deltaDepth: INTEGER _ 0, put: PutClosure _ NullPutClosure] = {
    IF put = NullPutClosure THEN put _ GetClosure[];
    PrintTV.Print[tv, put, defaultDepth + deltaDepth, defaultWidth]
    }; 
  
  ShowType: PUBLIC PROC [type: Type, put: PutClosure _ NullPutClosure] = {
    IF put = NullPutClosure THEN put _ GetClosure[];
    PrintTV.PrintType[type, put]
    }; 

  SyntaxError: ERROR = CODE;
  Errout: PrintTV.PutProc = {ERROR SyntaxError};
  
  ParseAndPrint: PUBLIC PROC [program: ROPE, put: PutClosure _ NullPutClosure] = {
    [] _ 
      PPOps.ParseStream
        [source: program,
         errPut: [proc: Errout, data: NIL],
         prettyPut: put
         ! SyntaxError => GO TO oops]; 
    EXITS oops => ERROR SyntaxError;
    }; 
  
  GetDefaultDepthAndWidth: PUBLIC PROC RETURNS [depth: NAT, width: NAT] = {
    -- return default depth and width for printing
    RETURN [defaultDepth, defaultWidth];
    };

  SetDefaultDepthAndWidth: PUBLIC PROC [depth: NAT _ 4, width: NAT _ 32] = {
    -- set default depth and width for printing
    defaultDepth _ depth;
    defaultWidth _ width;
    };

  END.