
// get next scheme token from standard input

void exit_bad_sexpr() {
  printf("bad s-expression");
  writeln();
  return;
}

void reset_data_stream_idx() {
  data_stream_idx = 0;
  return;
}

int my_getchar() {
  int my_ch;
  if (is_data_stream) {
    my_ch = data_stream[data_stream_idx];
    data_stream_idx = data_stream_idx + 1;
    return my_ch;
  }
  else
    return getchar();
}

int read_char_() {
  int ch;
  if (ch2 == eofatom)
    return ch2;
  else {
    ch = my_getchar();
    if (ch == -1) // EOF
      ch2 = eofatom;
    else
      ch2 = MmakeChar(ch);
    return ch2;
  }
}

int is_white_space() {
  if (ch == ' ')
    return 1;
  else
  if (ch == 10)
    return 1;
  else
  if (ch == 13)
    return 1;
  else
    return 0;
}

void skip_blanks() {
  while (is_white_space() || (ch == ';'))
    if (ch == ';') // skip over comment
      while (ch != newline_char)
        ch = my_getchar();
    else
      ch = my_getchar();
  return;
}

int is_alnum(int ch) {
  if ((ch >= 'a') && (ch <= 'z'))
    return 1;
  else
  if ((ch >= 'A') && (ch <= 'Z'))
    return 1;
  else
  if (isdigit(ch))
    return 1;
  else
    return 0;
}

int skip_past_alpha() {
  while (is_alnum(ch))
    ch = my_getchar();
  return ch;
}

int get_token() {
  int temp;
  int token;
  int ch_int;
  int previous_ch;

  token = 0;
  token_list = 0;
  token_new = 0;
  token_tail = 0;
  if (token_type != EOF_TOK) {
    skip_blanks();
    if (ch == -1) { // EOF
      token_type = EOF_TOK;
      token = eofatom;
    }
    else if (ch == '(') {
      token_type = OPAR_TOK;
      ch = my_getchar();
    }
    else if (ch == ')') {
      token_type = CPAR_TOK;
      ch = my_getchar();
    }
    else if (ch == '\'') {
      token_type = TIC_TOK;
      ch = my_getchar();
    }
    else if (ch == '#') {
      ch = my_getchar();
      if ((ch == 't') || (ch == 'f')) {

        // boolean true or false

        token_type = ATOM_TOK;
        if (ch == 't')
          token = Mtrue;
        else
          token = Mfalse;
        ch = my_getchar();
      }
      else if (ch == '\\') {

        // character object is identified by #\.
        // translate the ascii character to its character 
        // value

        token_type = ATOM_TOK;
        ch_int = my_getchar();
        ch = my_getchar();
        if ((ch_int == 's') && (ch == 'p')) { // space character
          ch_int = ' ';
          ch = skip_past_alpha();
        }
        else if ((ch_int == 'n') && (ch == 'e')) { // newline character
          ch_int = newline_char;
          ch = skip_past_alpha();
        }
        token = MmakeChar(ch_int);
      }
      else
        token_type = VECTOR_TOK;
    }
    else if (ch == '"') {
      previous_ch = ' ';
      token_type = STRING_TOK;
      ch = my_getchar();
      while (!((ch == '"') || ch == -1)) { // or EOF
        token_new = kons(MmakeChar(ch), 0);
        if (token_list != 0)
          token_tail = kdr(rplacd(token_tail, token_new));
        else {
          token_list = token_new;
          token_tail = token_new;
        }
        previous_ch = ch;
        ch = my_getchar();
        if (previous_ch == '\\') { // escape character
          temp = rplaca(token_tail, MmakeChar(ch));
          previous_ch = ch;
          ch = my_getchar();
        }
      }
      ch = my_getchar();
      token = list_to_string(token_list);
    }
    else {
      while (!(is_white_space() || (ch == '(') || (ch == ')') ||
            (ch == -1))) { // or EOF
        // upper case characters in a symbol are changed to lower case
        if (!case_sensitive)
          if (ch >= 'A' && ch <= 'Z')
            ch = 'a' + (ch - 'A');
        token_new = kons(MmakeChar(ch), 0);
        if (token_list != 0)
          token_tail = kdr(rplacd(token_tail, token_new));
        else {
          token_list = token_new;
          token_tail = token_new;
        }
        ch = my_getchar();
      }
      if ((MgetChar(kar(token_list)) == '.') && (kdr(token_list) == 0))
        token_type = DOT_TOK;
      else {
        token_type = ATOM_TOK;
        if (is_number_token(token_list))
          token = string_to_number(list_to_string(token_list));
        else
          token = intern(list_to_symbol(token_list));
      }
    }
  }
  else { // eof already occurred
    token_type = EOF_TOK;
    token = eofatom;
  }
  return token;
}
