(* Copyright (C) 1992, Digital Equipment Corporation                         *)
(* All rights reserved.                                                      *)
(* See the file COPYRIGHT for a full description.                            *)

(* Created by John Ellis                                       *)
(* Simplified and ported to Modula-3 by J.Stolfi on May 1990.  *)
(* Last modified on Thu Mar  5 10:10:08 PST 1992 by meehan     *)
(*      modified on Wed Feb 12 12:37:47 PST 1992 by muller     *)
(*      modified on Wed Nov 20 18:04:50 PST 1991 by stolfi     *)

MODULE Sx EXPORTS Sx, SxPrivate;

IMPORT Thread, List, Rd, TextRd, TextWr, Wr, FWr, SxSymbol, SxSyntax;

(**********************************************************)
(* CREATION *)
(**********************************************************)

PROCEDURE NewInteger (i: INTEGER): REF INTEGER =
  VAR integer: REF INTEGER;
  BEGIN
    IF (MinPreboxedInteger <= i) 
    AND (i <= MaxPreboxedInteger) THEN
      RETURN PreboxedInteger[i];
    ELSIF i = LAST (INTEGER) THEN
      RETURN LastInteger;
    ELSIF i = FIRST (INTEGER) THEN
      RETURN FirstInteger;
    ELSE
      integer := NEW (REF INTEGER);
      integer^ := i;
      RETURN integer;
    END;
  END NewInteger;

PROCEDURE NewChar (c: CHAR): REF CHAR =
  BEGIN
    RETURN PreboxedChar[c];
  END NewChar;

PROCEDURE NewBoolean (b: BOOLEAN): REF BOOLEAN =
  BEGIN
    RETURN PreboxedBoolean[b];
  END NewBoolean;

PROCEDURE NewReal (r: REAL): REF REAL =
  BEGIN
    IF r = 0.0 THEN
      RETURN RealZero;
    ELSIF r = 1.0 THEN
      RETURN RealOne;
    ELSIF r = 2.0 THEN
      RETURN RealTwo;
    ELSIF r = -1.0 THEN
      RETURN RealMinusOne;
    ELSIF r = 0.5 THEN
      RETURN RealHalf;
    ELSE 
      WITH rr = NEW(REF REAL) DO  rr^ := r; RETURN rr END
    END;
  END NewReal;

PROCEDURE NewLongReal (lr: LONGREAL): REF LONGREAL =
  BEGIN
    IF lr = 0.0d0 THEN
      RETURN LongRealZero;
    ELSIF lr = 1.0d0 THEN
      RETURN LongRealOne;
    ELSIF lr = 2.0d0 THEN
      RETURN LongRealTwo;
    ELSIF lr = -1.0d0 THEN
      RETURN LongRealMinusOne;
    ELSIF lr = 0.5d0 THEN
      RETURN LongRealHalf;
    ELSE 
      WITH rr = NEW(REF LONGREAL) DO  rr^ := lr; RETURN rr END
    END;
  END NewLongReal;

(**********************************************************)
(* PARSING                                                *)
(**********************************************************)

CONST 
  ExtraCharacters = "extra characters on input";

PROCEDURE Read(
    rd: Rd.T; 
    root: SxSymbol.T := NIL;
    syntax: Syntax := NIL; (* DefaultSyntax *)
  ): REFANY
  RAISES {ReadError, Rd.EndOfFile, Rd.Failure, Thread.Alerted} =
  BEGIN
    IF syntax = NIL THEN syntax := DefaultSyntax END;
    RETURN syntax.Read(rd, root)
  END Read;

PROCEDURE ReadDelimitedList(
    rd: Rd.T; 
    delim: CHAR; 
    root: SxSymbol.T := NIL;
    syntax: Syntax := NIL  (* DefaultSyntax *)
  ): List.T
  RAISES {ReadError, Rd.Failure, Thread.Alerted} =
  BEGIN
    IF syntax = NIL THEN syntax := DefaultSyntax END;
    RETURN syntax.ReadUntil(rd, delim, root)
  END ReadDelimitedList;

PROCEDURE FromText(
    text: TEXT; 
    root: SxSymbol.T := NIL;
    syntax: Syntax := NIL (* DefaultSyntax *)
  ): REFANY RAISES {ReadError, Rd.EndOfFile, Thread.Alerted} =
  <* FATAL Rd.Failure *>
  BEGIN
    WITH 
      rd = TextRd.New(text),
      val = Read(rd, root, syntax)
    DO
      IF Rd.EOF(rd) THEN RETURN val END;
      (* Check for extra garbage: *)
      TRY
        EVAL Read(rd, root, syntax);
      EXCEPT
      | Rd.EndOfFile => RETURN val
      END;
      RAISE ReadError(ExtraCharacters)
    END
  END FromText;

(**********************************************************)
(* PRINTING                                               *)
(**********************************************************)

TYPE
  ClosureProc =
    PROCEDURE (fwr: FWr.T) RAISES {PrintError, Wr.Failure, Thread.Alerted};

PROCEDURE WithFWr (proc        : ClosureProc;
                   underlyingWr: Wr.T;
                   lineWidth   : CARDINAL      := DefaultLineWidth)
  RAISES {PrintError, Wr.Failure, Thread.Alerted} =
  BEGIN
    WITH a = FWr.New (underlyingWr, lineWidth) DO
      TRY proc (a) FINALLY FWr.Close (a) END
    END
  END WithFWr;
    
PROCEDURE Print (wr     : Wr.T;
                 value  : REFANY;
                 elision: Elision    := NoElision;
                 root   : SxSymbol.T := NIL;
                 syntax : Syntax     := NIL;       )
  RAISES {PrintError, Wr.Failure, Thread.Alerted} =
  BEGIN
    IF syntax = NIL THEN syntax := DefaultSyntax END;
    IF NOT ISTYPE (wr, FWr.T) THEN
      PROCEDURE g (fwr: FWr.T)
        RAISES {PrintError, Wr.Failure, Thread.Alerted} =
        BEGIN
          syntax.Print (fwr, value, elision, root);
          FWr.Flush (fwr)
        END g;
      BEGIN
        WithFWr (g, wr)
      END
    ELSE
      syntax.Print (wr, value, elision, root);
    END;
  END Print;

PROCEDURE ToText (value  : REFANY;
                  elision: Elision    := NoElision;
                  root   : SxSymbol.T := NIL;
                  syntax : Syntax     := NIL; (* DefaultSyntax *)
  ): TEXT RAISES {PrintError, Thread.Alerted} =
  <* FATAL Wr.Failure *>
  BEGIN
    IF syntax = NIL THEN syntax := DefaultSyntax END;
    WITH wr = TextWr.New (), fwr = FWr.New (wr, DefaultLineWidth) DO
      TRY
        syntax.Print (fwr, value, elision, root);
        FWr.Flush (fwr);
        RETURN TextWr.ToText (wr)
      FINALLY
        FWr.Close (fwr);
        Wr.Close (wr)
      END
    END
  END ToText;

PROCEDURE PrintNL (wr     : Wr.T;
                   value  : REFANY;
                   elision: Elision    := NoElision;
                   root   : SxSymbol.T := NIL;
                   syntax : Syntax     := NIL;       )
  RAISES {PrintError, Wr.Failure, Thread.Alerted} =
  PROCEDURE g (fwr: FWr.T)
    RAISES {PrintError, Wr.Failure, Thread.Alerted} =
    BEGIN
      syntax.Print (fwr, value, elision, root);
      Wr.PutChar (wr, '\n');
      FWr.Flush (fwr)
    END g;
  BEGIN
    IF syntax = NIL THEN syntax := DefaultSyntax END;
    TYPECASE wr OF
    | FWr.T (fwr) => g (fwr)
    ELSE
      WithFWr (g, wr, DefaultLineWidth)
    END
  END PrintNL;

(**********************************************************)
(* UNDEFINED VALUE *)
(**********************************************************)

REVEAL UndefinedType = BRANDED REF INTEGER;

(**********************************************************)
(* MODULE INITIALIZATION *)
(**********************************************************)

PROCEDURE Init() =
  (*
    Assumes SxSynytax is fully initialized.
    Will be called by SxSyntax.Init. *)
  BEGIN
    Undefined := NEW (UndefinedType);
    FOR i := MinPreboxedInteger TO MaxPreboxedInteger DO
      PreboxedInteger[i]  := NEW (REF INTEGER);
      PreboxedInteger[i]^ := i
    END;
    FirstInteger := NEW (REF INTEGER); FirstInteger^ := FIRST(INTEGER);
    LastInteger  := NEW (REF INTEGER); LastInteger^  := LAST(INTEGER);
    FOR c := FIRST (CHAR) TO LAST (CHAR) DO
      PreboxedChar[c] := NEW (REF CHAR); PreboxedChar[c]^ := c
    END;
    True  := NEW (REF BOOLEAN); True^  := TRUE;
    False := NEW (REF BOOLEAN); False^ := FALSE;
    PreboxedBoolean[FALSE] := False;
    PreboxedBoolean[TRUE]  := True;
    Negation[FALSE] := True;
    Negation[TRUE]  := False;

    RealZero     := NEW (REF REAL); RealZero^     := 0.0;
    RealOne      := NEW (REF REAL); RealOne^      := 1.0;
    RealTwo      := NEW (REF REAL); RealTwo^      := 2.0;
    RealMinusOne := NEW (REF REAL); RealMinusOne^ := -1.0;
    RealHalf     := NEW (REF REAL); RealHalf^     := 0.5;

    LongRealZero     := NEW (REF LONGREAL); LongRealZero^     := 0.0d0;
    LongRealOne      := NEW (REF LONGREAL); LongRealOne^      := 1.0d0;
    LongRealTwo      := NEW (REF LONGREAL); LongRealTwo^      := 2.0d0;
    LongRealMinusOne := NEW (REF LONGREAL); LongRealMinusOne^ := -1.0d0;
    LongRealHalf     := NEW (REF LONGREAL); LongRealHalf^     := 0.5d0;
    
    EmptyVector := NEW(REF ARRAY OF REFANY, 0);

    DefaultSyntax := SxSyntax.Standard();
  END Init;

BEGIN
  (* Sx.Init must be called by SxSyntax.m3. *)
END Sx.