Module: C-lexer-internal
Author: Toby Weinberg
Copyright:    Original Code is Copyright (c) 1995-2004 Functional Objects, Inc.
              All rights reserved.
License:      See License.txt in this distribution for details.
Warranty:     Distributed WITHOUT WARRANTY OF ANY KIND

ignorable(source-name-setter, lexer-warning);

// This file contains stream, state and state machine lexer definitions for
// pre-lexing a character input stream.  Pre-lexing is required for ISO C
// parsing.  It removes escaped line-breaks and handles trigraphs and trigraph
// escapes.  It also keeps the line counter so that line numbers reported
// in error messages match the source before pre-lexing and macro
// expansion.  To see that this is really a separate pass consider that:
//
//    "??/" => "\"
//    "\<lf>"  => "" (escaped new-line)
//    "??/<lf>" => "" (escaped new-line)
//    "\??/" => "??/"
//    "?\?/" => "??/"
//    "??/??/" => "\\"
//
// In particular it is not the case that "??/??/" is interpreted as "\??/"
// and then reduced to "??/".  Unlike what is done for escaping new lines
// using "??/" as equivalent to "\".  This takes much more look ahead than
// the lexer is prepared for.

// FSM states

define constant <pre-lexer-state> = <integer>;

define constant  $S0 =  0;
define constant  $S1 =  1;
define constant  $S2 =  2;
define constant  $S3 =  3;
define constant  $S4 =  4;
define constant  $S5 =  5;
define constant  $S6 =  6;
define constant  $S7 =  7;
define constant  $SFINISHED = 8;

define macro current-char
  { current-char ( ?stream:name ) }
    => { ?stream.current-character }
end macro;

define macro current-state
  { current-state ( ?stream:name ) } => { ?stream.state }
end macro;

define macro next-line
  { next-line ( ?stream:name ) }
    => { ?stream.line-number
          := ?stream.line-number + 1 }
end macro;

define macro next-state
  { next-state ( ?stream:name, ?state-number:name ) }
    => { ?stream.state := ?state-number }
end macro;

define macro next-char
  { next-char ( ?stream:name ) }
    => { ?stream.current-character
           := read-element(?stream.inner-stream, on-end-of-stream: #"eoi")
           // := read-element-from-file-stream(?stream)
          }
end macro;

// <pre-lexer>s are wrapper streams.
define class <pre-lexer> (<wrapper-stream>)
  slot source-name :: <string>, init-keyword: source-name:,
    init-value: "unknown stream";
  slot line-number :: <integer>,
    init-keyword: line-number:, init-value: 1;
  slot current-character ::  type-union(<character>, one-of(#"eoi"),
                                        one-of(#f)),
    init-keyword: current-character:, init-value: #f;
  slot state :: <pre-lexer-state>, init-keyword: state:, init-value: $S0;
end class;

define method close (the-stream :: <pre-lexer>, #key) => ()
  close(the-stream.inner-stream);
end method;

define method print-object
    (the-described-stream :: <pre-lexer>, the-stream :: <stream>) => ();
end method;

define method current-line (stream :: <pre-lexer>) => (result :: <integer>)
  stream.line-number
end method;

// This needs a little more thought if it ever becomes important.  The
// current-character is frequently already read when the streams are
// switched so one further character on the old stream is read.  Also it
// isn't clear what should happen when the stream is in a push-down state.
define method inner-stream-setter
    (the-inner-stream :: <stream>, the-outer-stream :: <pre-lexer>)
 => (result :: <stream>);        // SML 10/13/97: was: false-or(<stream>)
  let result = next-method();
  if ( ~ current-char(the-outer-stream)
        | (current-char(the-outer-stream) = #"eoi"))
    next-char(the-outer-stream);
  end if;
  result
end method;

// If the pre-lexer stream is newly opened and hasn't inherited a current
// character from state of a previous pre-lexer inner-stream then read the
// first character from the inner-stream.
define method initialize (new-lexer :: <pre-lexer>, #key)
  next-method();
  if ( ~ current-char(new-lexer) )
    next-char(new-lexer);
  end if;
end method;

define method read-element (s :: <pre-lexer>, #key on-end-of-stream = #"eoi")
 =>(result :: <object>);
  let result = #f;
  while ( ~ result )
    select (current-state(s))
      $S0 =>
        select (current-char(s))
          '\\' => next-state(s, $S1); next-char(s);
          '?' => next-state(s, $S4); next-char(s);
          '\n' => result := '\n'; next-line(s); next-char(s);
          '\r' => next-line(s); next-state(s, $S3); next-char(s);
          #"eoi" => result := on-end-of-stream;
          otherwise => result := current-char(s); next-char(s);
        end select;
      $S1 => // "\\" seen -- look for escaped new lines or ?s
        select (current-char(s))
          '\n' => next-line(s); next-state(s, $S0); next-char(s);
          '\r' => next-line(s); next-state(s, $S2); next-char(s);
          '?'  => result := '?'; next-state(s, $S0); next-char(s);
          otherwise => result := '\\'; next-state(s,$S0);
        end select;
      $S2 => // "\\\r"  seen -- escaped cr/lf?
        select (current-char(s))
          '\n' => next-state(s, $S0); next-char(s);
          otherwise => next-state(s, $S0);
        end select;
      $S3 => // "\r"  seen from $S0  --  cr/lf?
        select (current-char(s))
          '\n' => next-char(s); result := '\n'; next-state(s, $S0);
          otherwise => result := '\n'; next-state(s, $S0);
        end select;
      $S4 => // "?"  seen -- trigraph beginning from $S0?
        select (current-char(s))
          '?' => next-state(s, $S5); next-char(s);
          otherwise => result := '?'; next-state(s,$S0);
        end select;
      $S5 => // "??"  seen -- trigraph beginning from $S0?
        select (current-char(s))
          '(' => result := '['; next-state(s, $S0); next-char(s);
          '<' => result := '{'; next-state(s, $S0); next-char(s);
          '/' => next-state(s, $S7); next-char(s);
          '\'' => result := '^'; next-state(s, $S0); next-char(s);
          '=' => result := '#'; next-state(s, $S0); next-char(s);
          ')' => result := ']'; next-state(s, $S0); next-char(s);
          '>' => result := '}'; next-state(s, $S0); next-char(s);
          '!' => result := '|'; next-state(s, $S0); next-char(s);
          '-' => result := '~'; next-state(s, $S0); next-char(s);
          otherwise => result := '?'; next-state(s,$S6);
        end select;
      $S6 =>
        result := '?'; next-state(s, $S0);
      $S7 => // "??/"  seen -- trigraph beginning from $S0? Don't accept
              // this as escaping a ? but do let it escape new-lines
        select (current-char(s))
          '\n' => next-line(s); next-state(s, $S0); next-char(s);
          '\r' => next-line(s); next-state(s, $S2); next-char(s);
          otherwise => result := '\\'; next-state(s, $S0);
        end select;
      otherwise =>
        error("internal error: unrecognized pre-lexer state %= \n",
              current-state(s));
    end select;
  end while;
  result
end method read-element;

define method stream-at-end? (s :: <pre-lexer>) => (at-end? :: <boolean>)
  (current-state(s) = $S0) & (current-char(s) = #"eoi")
end method stream-at-end?;

define method lexer-warning (pre-lexer :: <pre-lexer>,
                             format-string :: <string>,
                             #rest format-arguments)
  format-out("\n\npre-lexer warning on line: %= of file: %s",
             pre-lexer.current-line,
             pre-lexer.source-name);
  apply(signal, format-string, format-arguments);
end method;

define method test-pre-lexer (string)
  let stream = make(<pre-lexer>,
                    inner-stream:
                      make(<string-stream>, direction: #"input",
                           contents: string));
  let result-list = #();
  let current-character = read-element(stream);
  while (current-character ~=  #"eoi")
    result-list := add!(result-list,  current-character);
    current-character := read-element(stream);
  end while;
  result-list := add!(result-list,  current-character);
  close(stream);
  values(reverse!(result-list),
         current-line(stream));
end method test-pre-lexer;

