/[gcl]/gcl/o/read.d
ViewVC logotype

Diff of /gcl/o/read.d

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.35 by camm, Wed Oct 12 03:12:57 2005 UTC revision 1.36 by camm, Fri Oct 14 22:41:25 2005 UTC
# Line 79  struct sharp_eq_context_struct { Line 79  struct sharp_eq_context_struct {
79  #define MAX_PACKAGE_STACK 1024  #define MAX_PACKAGE_STACK 1024
80  static object P0[MAX_PACKAGE_STACK],*PP0=P0,LP;  static object P0[MAX_PACKAGE_STACK],*PP0=P0,LP;
81    
82    static int inlp;
83    
84  static void  static void
85  setup_READ()  setup_READ()
86  {  {
# Line 110  setup_READ() Line 112  setup_READ()
112    
113          PP0=P0;          PP0=P0;
114          LP=NULL;          LP=NULL;
115            inlp=0;
116    
117  }  }
118    
# Line 478  BEGIN: Line 481  BEGIN:
481                          FEerror("The readmacro ~S returned ~D values.",                          FEerror("The readmacro ~S returned ~D values.",
482                                   2, fun_box[0], vs_top[-1]);                                   2, fun_box[0], vs_top[-1]);
483                  }                  }
484                  result = vs_base[0];                  result = READsuppress ? Cnil : vs_base[0]; /*FIXME, centralize here rather than in
485                                                                 reader macros ??*/
486                  vs_base = old_vs_base;                  vs_base = old_vs_base;
487                  vs_reset;                  vs_reset;
488                  return(result);                  return(result);
# Line 527  BEGIN: Line 531  BEGIN:
531                  } else {                  } else {
532    
533                    if (trt(c)==trait_invalid)                    if (trt(c)==trait_invalid)
534                      READER_ERROR("Cannot read character");                      READER_ERROR(in,"Cannot read character");
535    
536                    if ('A' <= char_code(c) && char_code(c) <= 'z') {                    if ('A' <= char_code(c) && char_code(c) <= 'z') {
537                      if ('a' <= char_code(c) && char_code(c) <= 'z' &&                      if ('a' <= char_code(c) && char_code(c) <= 'z' &&
# Line 644  SYMBOL: Line 648  SYMBOL:
648          return(x);          return(x);
649  }  }
650    
 static int inlp;  
   
651  static void  static void
652  Lleft_parenthesis_reader()  Lleft_parenthesis_reader()
653  {  {
# Line 1142  Lright_parenthesis_reader() Line 1144  Lright_parenthesis_reader()
1144  {  {
1145          check_arg(2);          check_arg(2);
1146          if (!inlp)          if (!inlp)
1147            READER_ERROR("Right paren found with no left.");            READER_ERROR(vs_base[0],"Right paren found with no left.");
1148          vs_popp;          vs_popp;
1149          vs_popp;          vs_popp;
1150                  /*  no result  */                  /*  no result  */
# Line 1181  extra_argument(int); Line 1183  extra_argument(int);
1183  static void  static void
1184  Lsharp_C_reader()  Lsharp_C_reader()
1185  {  {
1186          object x, c;          object x;
1187    
1188          check_arg(3);          check_arg(3);
1189          if (vs_base[2] != Cnil && !READsuppress)          if (vs_base[2] != Cnil && !READsuppress)
1190                  extra_argument('C');                  extra_argument('C');
1191          vs_popp;          vs_popp;
1192          vs_popp;          vs_popp;
1193          c = read_char(vs_base[0]);  
1194          if (char_code(c) != '(')          if (READsuppress) {
1195                  FEerror("A left parenthesis is expected.", 0);            read_object(vs_base[0]);
1196          delimiting_char = code_char(')');            vs_base[0]= Cnil;
         x = read_object(vs_base[0]);  
         if (x == OBJNULL)  
                 FEerror("No real part.", 0);  
         if (!realp(x))  
           TYPE_ERROR(x,TSor_rational_float);  
         vs_push(x);  
         delimiting_char = code_char(')');  
         x = read_object(vs_base[0]);  
         if (x == OBJNULL)  
                 FEerror("No imaginary part.", 0);  
         if (!realp(x))  
           TYPE_ERROR(x,TSor_rational_float);  
         vs_push(x);  
         delimiting_char = code_char(')');  
         x = read_object(vs_base[0]);  
         if (x != OBJNULL)  
                 FEerror("A right parenthesis is expected.", 0);  
         if (READsuppress) vs_base[0]= Cnil ;  
          else  
         if (contains_sharp_comma(vs_base[1]) ||  
             contains_sharp_comma(vs_base[2])) {  
                 vs_base[0] = alloc_object(t_complex);  
                 vs_base[0]->cmp.cmp_real = vs_base[1];  
                 vs_base[0]->cmp.cmp_imag = vs_base[2];  
1197          } else {          } else {
1198                  check_type_number(&vs_base[1]);            x = read_char(vs_base[0]);
1199                  check_type_number(&vs_base[2]);            if (char_code(x) != '(')
1200                  vs_base[0] = make_complex(vs_base[1], vs_base[2]);              READER_ERROR(vs_base[0],"A left parenthesis is expected.");
1201              delimiting_char = code_char(')');
1202              x = read_object(vs_base[0]);
1203              if (x==OBJNULL || !realp(x))
1204                TYPE_ERROR(x,TSor_rational_float);
1205              vs_push(x);
1206              delimiting_char = code_char(')');
1207              x = read_object(vs_base[0]);
1208              if (x==OBJNULL || !realp(x))
1209                TYPE_ERROR(x,TSor_rational_float);
1210              vs_push(x);
1211              delimiting_char = code_char(')');
1212              x = read_object(vs_base[0]);
1213              if (x != OBJNULL)
1214                READER_ERROR(vs_base[0],"A right parenthesis is expected.");
1215              if (contains_sharp_comma(vs_base[1]) ||
1216                  contains_sharp_comma(vs_base[2])) {
1217                vs_base[0] = alloc_object(t_complex);
1218                vs_base[0]->cmp.cmp_real = vs_base[1];
1219                vs_base[0]->cmp.cmp_imag = vs_base[2];
1220              } else {
1221                check_type_number(&vs_base[1]);
1222                check_type_number(&vs_base[2]);
1223                vs_base[0] = make_complex(vs_base[1], vs_base[2]);
1224              }
1225          }          }
1226          vs_top = vs_base + 1;          vs_top = vs_base + 1;
1227  }  }
# Line 1679  Lsharp_R_reader() Line 1681  Lsharp_R_reader()
1681          vs_popp;          vs_popp;
1682          vs_popp;          vs_popp;
1683          read_constituent(vs_base[0]);          read_constituent(vs_base[0]);
1684            vs_base[0]
1685            = parse_number(token_buffer, token->st.st_fillp, &i, radix);
1686          if (READsuppress) {          if (READsuppress) {
1687                  vs_base[0] = Cnil;                  vs_base[0] = Cnil;
1688                  return;                  return;
1689          }          }
         vs_base[0]  
         = parse_number(token_buffer, token->st.st_fillp, &i, radix);  
1690          if (vs_base[0] == OBJNULL || i != token->st.st_fillp)          if (vs_base[0] == OBJNULL || i != token->st.st_fillp)
1691                  FEerror("Cannot parse the #R readmacro.", 0);                  FEerror("Cannot parse the #R readmacro.", 0);
1692          if (type_of(vs_base[0]) == t_shortfloat ||          if (type_of(vs_base[0]) == t_shortfloat ||
# Line 1738  Lsharp_sharp_reader() Line 1740  Lsharp_sharp_reader()
1740                  vs_popp;                  vs_popp;
1741                  vs_popp;                  vs_popp;
1742                  vs_base[0] = Cnil;                  vs_base[0] = Cnil;
1743                    return;
1744          }          }
1745          if (vs_base[2] == Cnil)          if (vs_base[2] == Cnil)
1746                  FEerror("The ## readmacro requires an argument.", 0);                  FEerror("The ## readmacro requires an argument.", 0);
# Line 1880  Lsharp_vertical_bar_reader() Line 1883  Lsharp_vertical_bar_reader()
1883  static void  static void
1884  Ldefault_dispatch_macro()  Ldefault_dispatch_macro()
1885  {  {
1886          READER_ERROR("The default dispatch macro signalled an error.");          READER_ERROR(vs_base[0],"The default dispatch macro signalled an error.");
1887  }  }
1888    
1889  /*  /*
# Line 1895  Lsharp_p_reader() Line 1898  Lsharp_p_reader()
1898          vs_popp;          vs_popp;
1899          vs_popp;          vs_popp;
1900          vs_base[0] = read_object(vs_base[0]);          vs_base[0] = read_object(vs_base[0]);
1901          vs_base[0] = coerce_to_pathname(vs_base[0]);          vs_base[0] = READsuppress ? Cnil : coerce_to_pathname(vs_base[0]);
1902  }  }
1903    
1904  /*  /*

Legend:
Removed from v.1.35  
changed lines
  Added in v.1.36

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26