`BUFSTREAM.ML`;

% WARNING:  The handling of I/O failures is not properly developed yet. %

let eol = `/L`;

let FileNameStdIn = `<StdIn>`;

let FileNameString = `<string>`;

%let outprompt( p: string ): unit = (outstring p; flush());%
nonfix outprompt 91 1;
let rec outprompt (x:string):unit = outprompt x;

let CastlePrompt : (unit -> unit) ref = ref (\x.x);  % added AJG 29/4/91 %

let type File = (|
    buffer: buffer;
    filePtr: int ref;  scanPtr: int ref;  endPtr: int ref;
    fileInfo: [|
        file: (| filename: string; stream: instream; interactive: bool |);
        string: unit |];
    issuePrompt: bool ref  |);

let type BufStreamStack = [|
    file: File;
    filenameList: ( string # int ) list ref  |]  list;

let type BufStream <=> (|
    file: File ref;
    eof: bool ref;
    filenameList: ( string # int ) list ref;
    stack:  BufStreamStack ref;
    prompt: string ref;
    monFns: ((string # int -> unit) # (string # int -> unit)) ref |);

let rec { stackDepth( l: BufStreamStack ): int =
    if null(l) then 0
    else (if hd(l) is file then 1 else 0) + stackDepth(tl(l)) }

ins BufStreamDepth( bufStream: BufStream ): int =
    stackDepth(!(repBufStream(bufStream).stack));

let DoMonIO(filename) =
    case !Print.Use of [|
    none . false;
    some . filename <> FileNameStdIn;
    all . true |]
ins {
    MonOpen(filename,bufStream) =
        if DoMonIO(filename) then
            let monFnOpen = fst(!(repBufStream(bufStream).monFns)) in
                monFnOpen(filename,BufStreamDepth(bufStream))
        else ()
and
    MonClose(filename,depth,monFnClose) =
        if DoMonIO(filename) then monFnClose(filename,depth) else () };

let OpenFile( (filename: string, n: int), bufStream: BufStream ): File =
    if n = 0 then (
        MonOpen(FileNameString,bufStream);
        (|  buffer = absBuffer(filename);
            filePtr = ref 1;
            scanPtr = ref 1;
            endPtr = ref(LengthTok(filename)+1);
            fileInfo = [|string|];
            issuePrompt = ref true |) )
    else (
        (   let stream =
                if filename = FileNameStdIn then CurrentState().StdIn
                else Openstream(filename)
            enc interactive = Interactive(stream)
            in (
                MonOpen(filename,bufStream);
                (|  buffer = BufferOfLength(n);
                    filePtr = ref 1;  scanPtr = ref 1;  endPtr = ref 1;
                    fileInfo = [|file=(|filename;stream;interactive|)|];
                    issuePrompt = ref true  |) ) )
        ?? "OpenStream" (
            outstring(`[File "`); outstring(filename);
            outstring(`" cannot be opened]`); newline(1);
            ReEnter() ) );

let CloseFile(| filename; stream |) =
    if filename = FileNameStdIn then () else CloseInStream(stream);

let nilFile(): File =
   (|
        buffer = BufferOfLength(0);
        filePtr = ref 1; scanPtr = ref 1; endPtr = ref 1;
        fileInfo = [|string|];
        issuePrompt = ref true |)

ins {
    NewBufStream( monFns: ((string # int -> unit) # (string # int -> unit)) )
    : BufStream
    =
        absBufStream(|
            file = ref(nilFile());
            eof = ref true;
            filenameList = ref nil;
            stack = ref nil;
            prompt = ref ``;
            monFns = ref monFns |)

and ClearBufStream( bufStream: BufStream ): unit =
    let (| file; eof; filenameList; stack; prompt; monFns=_ |) =
        repBufStream(bufStream)
    in (
        file := nilFile();
        eof := true;
        filenameList := nil;
        stack := nil;
        prompt := `` ) };

% let InitBufStream( bufStream: BufStream ): unit = ... %

% This function aborts all input from the currently open file, and from all
  open files and pending filenames on the stack until it finds an open
  interactive file when it resumes input from that, or until the stack is
  exhausted in which case it closes the entire BufStream. %
let { rec abortToInteractiveBufStreamStack(
        bufStream: BufStream, l: BufStreamStack ): unit
=
    let (| file; eof; filenameList; stack; prompt=_; monFns |) =
        repBufStream(bufStream)
    enc monFnClose = snd(!monFns)
    in
        if null(l) then ClearBufStream(bufStream)
        else
            case hd(l) of [|
            file = f .
                case f.fileInfo of [|
                file = (| filename; stream; interactive |) .
                    if interactive then (
                       % Memo: Should also check "issuePrompt" to check at eol %
                        f.filePtr := 1; f.scanPtr := 1; f.endPtr := 1;
                        file := f;
                        eof := false;
                        filenameList := nil;
                        stack := tl(l) )
                    else (
                        CloseFile(|filename;stream|);
                        MonClose(filename,0,monFnClose);  %TEMPORARY%
                        abortToInteractiveBufStreamStack(bufStream,tl(l)) );
                string . (
                    MonClose(FileNameString,0,monFnClose);  %TEMPORARY%
                    abortToInteractiveBufStreamStack(bufStream,tl(l)) ) |];
            filenameList .
                abortToInteractiveBufStreamStack(bufStream,tl(l)) |] }
                % Memo: Could also have a monitoring function here. %

ins AbortToInteractiveBufStream( bufStream: BufStream ): unit =
    let (| file; eof; filenameList=_; stack; prompt=_; monFns=_ |) =
        repBufStream(bufStream)
    in
        abortToInteractiveBufStreamStack(
            bufStream,
            if !eof then !stack else [|file= !file|] :: !stack );

let { rec CloseBufStreamStack( monFnClose, l: BufStreamStack ) : unit =
    if null(l) then ()
    else
        case hd(l) of [|
        file = f .
            case f.fileInfo of [|
            file = (| filename; stream; interactive |) . (
                CloseFile(|filename;stream|);
                MonClose(filename,0,monFnClose);  %TEMPORARY%
                CloseBufStreamStack(monFnClose,tl(l)) );
            string . (
                MonClose(FileNameString,0,monFnClose);  %TEMPORARY%
                CloseBufStreamStack(monFnClose,tl(l)) ) |];
        filenameList . CloseBufStreamStack(monFnClose,tl(l)) |] }

ins CloseBufStream( bufStream: BufStream ): unit =
    let (| file; eof; filenameList; stack; prompt=_; monFns |) =
        repBufStream(bufStream)
    in (
        CloseBufStreamStack(
            snd(!monFns),
            if !eof then !stack
            else ( eof := true;  [|file= !file|] :: !stack ) );
        ClearBufStream(bufStream) );

let SetPrompt( t: string, bufStream: BufStream ): unit =
    repBufStream(bufStream).prompt := t;

% Memo:  The following function could be simplified by re-organizing %
let rec BreakBufStream( bufStream: BufStream ): unit =
    let (| file; eof; filenameList; stack; prompt; monFns=_ |) =
        repBufStream(bufStream)
    in (
        prompt := `- `;  % TEMPORARY HACK %
        if null(!filenameList) then
            if !eof then
                if null(!stack) then failwith `CtrlZ`
                else
                    case hd(!stack) of [|
                    file = f . (file := f; eof := false; stack := tl(!stack) );
                    filenameList = l .
                        if null(!l) then
                            ( stack := tl(!stack); BreakBufStream(bufStream) )
                        else
                            let fn :: ltl = !l in (
                                % N.B. Order below is critical since OpenFile %
                                %      can fail.  Similar code below (q.v.).  %
                                l := ltl;
                                file := OpenFile(fn,bufStream);
                                eof := false ) |]
            else ()
        else
            let fn :: l = !filenameList in (
                % N.B. Order below is critical since OpenFile can fail.      %
                % First update "filenameList" and "stack" (stacking current  %
                %     file if open and setting "eof").                       %
                filenameList := nil;
                if !eof then ()
                else ( stack := ([| file = !file |] :: !stack);  eof := true );
                if null(l) then ()
                else stack := [| filenameList = ref(l) |] :: !stack;
                % Next attempt to open new file. %
                file := OpenFile(fn,bufStream);
                % Finally update "file" and unset "eof" if open successful. %
                eof := false ) );

let UseFile( fn: string, n: int, bufStream: BufStream ): unit =
    let filenameList = repBufStream(bufStream).filenameList in
        filenameList := !filenameList @ [(fn,n)];

let UseStdIn( n: int, bufStream: BufStream ): unit =
    UseFile(FileNameStdIn,n,bufStream);

let UseString( t: string, bufStream: BufStream ): unit =
    UseFile(t,0,bufStream);

let ReadMore( bufStream: BufStream ): int =
    let (| file; eof; filenameList=_; stack=_; prompt; monFns |) =
        repBufStream(bufStream)
    in
        if !eof then 0
        else
            let (| buffer; filePtr; scanPtr; endPtr; fileInfo; issuePrompt |) =
                !file
            in
                case fileInfo of [|
                file = (| filename; stream; interactive |) . (
                    MoveWithinBuffer(buffer, !filePtr, 1, !endPtr - !filePtr);
                    let m = !filePtr - 1 in (
                        scanPtr := !scanPtr - m;
                        endPtr := !endPtr - m;
                        filePtr := 1 );
                    if !endPtr > LengthTok(repBuffer(buffer)) then (
                        outstring(`[Stream buffer overflow]`); 
                        newline(1); ReEnter() )
                    else ();
                    let n = (
                        if interactive And !issuePrompt then (
% Changed AJG, 29/4/91 %	(!CastlePrompt)();outprompt(!prompt))
                        else ();
                        ReadToBuffer(stream,buffer,!endPtr)
                            ?? "ReadToTok" 
                              ( outstring(`[I//o error]`); 
                                newline(1); FatalCrash() ) )
                    in (
                        endPtr := !endPtr+n;
                        if n=0 then (
                            eof := true;
                            CloseFile(|filename;stream|);
                            MonClose(
                                filename,
                                BufStreamDepth(bufStream),
                                snd(!monFns) ) )
                        else
                            issuePrompt :=
                                substring(repBuffer(buffer),!endPtr-1,1) = eol;
                        n ) );
                string . (
                    eof := true;
                    snd(!monFns)(FileNameString,BufStreamDepth(bufStream));
                    0 ) |];

let ScanChar( bufStream: BufStream ): string =
    let (| buffer; filePtr=_; scanPtr; endPtr; fileInfo=_; issuePrompt=_ |) =
        !(repBufStream(bufStream).file)
    enc n =
        if !scanPtr >= !endPtr then
            if ReadMore(bufStream) > 0 then 1 else 0
        else 1
    enc ptr = !scanPtr
    in ( scanPtr := ptr+n; substring(repBuffer(buffer),ptr,n) );

let rec PeekChar( i: int, bufStream: BufStream ): string =
    if i < 1 then failwith `PeekChar`
    else
        let
            (| buffer; filePtr=_; scanPtr; endPtr; fileInfo=_; issuePrompt=_ |)
        =
            !(repBufStream(bufStream).file)
        in
            if !scanPtr+i-1 >= !endPtr then
                if ReadMore(bufStream) > 0 then PeekChar(i,bufStream) else ``
            else substring(repBuffer(buffer),!scanPtr+i-1,1);

let rec ScanUntilIn( set: string, bufStream: BufStream ): string =
    let (| buffer; filePtr=_; scanPtr; endPtr; fileInfo=_; issuePrompt=_ |) =
        !(repBufStream(bufStream).file)
    in (
        scanPtr :=
            ScanTokUntilIn(set,repBuffer(buffer),!scanPtr,!endPtr - !scanPtr);
        if !scanPtr >= !endPtr then
            if ReadMore(bufStream) > 0 then ScanUntilIn(set,bufStream) else ``
        else substring(repBuffer(buffer),!scanPtr,1) );

let rec ScanWhileIn( set: string, bufStream: BufStream ): string =
    let (| buffer; filePtr=_; scanPtr; endPtr; fileInfo=_; issuePrompt=_ |) =
        !(repBufStream(bufStream).file)
    in (
        scanPtr :=
            ScanTokWhileIn(set,repBuffer(buffer),!scanPtr,!endPtr - !scanPtr);
        if !scanPtr >= !endPtr then
            if ReadMore(bufStream) > 0 then ScanWhileIn(set,bufStream) else ``
        else substring(repBuffer(buffer),!scanPtr,1) );

let GetTok( bufStream: BufStream ): string =
    let (| buffer; filePtr; scanPtr; endPtr=_; fileInfo=_; issuePrompt=_ |) =
        !(repBufStream(bufStream).file)
    enc ptr = !filePtr
    in ( filePtr := !scanPtr; substring(repBuffer(buffer),ptr,!scanPtr-ptr) );

let SkipTok( bufStream: BufStream ): unit =
    let file = !(repBufStream(bufStream).file)
    enc { scanPtr = file.scanPtr and filePtr = file.filePtr }
    in filePtr := !scanPtr;

let GetChar( bufStream: BufStream ): string =
    let (| buffer; filePtr; scanPtr; endPtr; fileInfo=_; issuePrompt=_ |) =
        !(repBufStream(bufStream).file)
    enc n =
        if !scanPtr >= !endPtr then
            if ReadMore(bufStream) > 0 then 1 else 0
        else 1
    enc ptr = !scanPtr
    in (
        scanPtr := ptr+n; filePtr := !scanPtr;
        substring(repBuffer(buffer),ptr,n) );

let MonFnOpen(t,n) =
    ( outstring(`[Opening `); outstring(t); outstring(`]`); newline(1) );

let MonFnClose(t,n) =
    ( outstring(`[Closing `); outstring(t); outstring(`]`); newline(1) );
