Changeset 2465


Ignore:
Timestamp:
Feb 26, 2007, 4:35:12 PM (14 years ago)
Author:
yura
Message:
  • Begining of error processing.
Location:
to-imperative/trunk
Files:
5 added
7 edited

Legend:

Unmodified
Added
Removed
  • to-imperative/trunk/compiler/rfp_helper.rf

    r2455 r2465  
    11// $Id$
    22
    3 $use Access Arithm Box Class Compare StdIO Table;
     3$use Access Arithm Box Class Compare Convert List StdIO Table;
    44
    55RFP-Debug? =
     
    6868};
    6969
     70Make-Name s.WORD-or-QWORD e.origname,
     71  {
     72    s.WORD-or-QWORD : WORD, <In-Table? &RFP-Options CASE-INSENSITIVE> = <To-Upper e.origname>;
     73    e.origname;
     74  } :: e.origname,
     75  <Concat <Map! &To-Word (<Separate ('.') e.origname>)>>;
  • to-imperative/trunk/compiler/rfp_helper.rfi

    r2455 r2465  
    2222$func? In? (e.pattern) expr = ;
    2323
    24 
     24// Make refal name ('a.b.c' -> "a" "b" "c")
     25$func Make-Name s.WORD-or-QWORD e.origname = e.name ;
  • to-imperative/trunk/compiler/rfp_lex.rf

    r2456 r2465  
    1818// $Id$
    1919
    20 $use "rfp_err" "rfp_helper" "rfp_src" ;
    21 $use Access Apply Arithm Box Class Compare Convert Dir Dos File List StdIO Table ;
    22 
    23 $box Position Source ;
    24 
     20$use Access Apply Box Class Compare Convert List StdIO Table ;
     21$use "rfp_helper" "rfp_src" ;
     22
     23$box Errors Position Source ;
     24
     25$func Add-Error (e.position) (e.message) = ;
     26$func Add-Warning (e.position) (e.message) = ;
    2527$func? Get-Source-Line = e.line ;
    2628$func Scan-Token e.line = e.tokens (e.new-line) ;
     
    4648  <Store &Source e.source>,
    4749  <Store &Position 0 1>,
     50  <Store &Errors>,
    4851  () $iter e.tokens <Scan-Token e.line> :: e.tokens (e.line),
    4952  e.tokens : e ((e) (EOF)) =
    50   e.tokens;
     53  {
     54    <? &Errors> : e (ERROR e) e = $fail;
     55    e.tokens;
     56  };
     57
     58RFP-Lexer-Errors = <? &Errors>;
     59
     60Add-Error (e.position) (e.message) = <Put &Errors (ERROR (e.position) (e.message))>;
     61
     62Add-Warning (e.position) (e.message) = <Put &Errors (WARNING (e.position) (e.message))>;
     63
     64Get-Source-Line =
     65  <RFP-Src-Get-Line <? &Source>> :: e.line,
     66  <Next-Row>,
     67  e.line;
    5168
    5269Scan-Token e.line =
     
    94111                    '{' = TLBRACE;
    95112                  } :: s.tk =
    96                     <Next-Column>, ((e.saved-position) (s.tk)) (e.rest2);
    97                 <RFP-Error (<Token-Position>)
    98                   ("Invalid character \'" s.char2 "\'")>,
     113                  <Next-Column>, ((e.saved-position) (s.tk)) (e.rest2);
     114                <Add-Error (<Token-Position>) ("Invalid character \'" s.char2 "\'")>,
    99115                  <Next-Column>,
    100116                  /*empty*/ (e.rest2);
    101117              };
    102               <RFP-Error (<Token-Position>) ("Unexpected end of line")>,
     118              <Add-Error (<Token-Position>) ("Unexpected end of line")>,
    103119                /*empty*/ (/*empty*/);
    104120            };
     
    107123              '/' e.rest2 = /*empty*/ (/*empty*/);
    108124              '*' e.rest2 = <Next-Column>, /*empty*/ (<Skip-Comment e.rest2>);
    109               s.err e.rest2 = <RFP-Error (<Token-Position>)
    110                 ("Invalid character \'" s.err "\'")>,
     125              s.err e.rest2 = <Add-Error (<Token-Position>) ("Invalid character \'" s.err "\'")>,
    111126                <Next-Column>,
    112127                /*empty*/ (e.rest2);
    113               = <RFP-Error (<Token-Position>) ("Unexpected end of line")>,
     128              = <Add-Error (<Token-Position>) ("Unexpected end of line")>,
    114129                /*empty*/ (/*empty*/);
    115130            };
     
    125140      } :: (e.tk) (e.new-line),
    126141        ((e.saved-position) (e.tk)) (e.new-line);
    127       <RFP-Error (<Token-Position>) ("Invalid character \'" s.char "\'")>,
     142      <Add-Error (<Token-Position>) ("Invalid character \'" s.char "\'")>,
    128143        <Next-Column>,
    129144        /*empty*/ (e.rest);
    130145    };
    131146  };
    132 
    133 Get-Source-Line =
    134   <RFP-Src-Get-Line <? &Source>> :: e.line,
    135   <Next-Row>,
    136   e.line;
    137147
    138148Blank? s.char =
     
    168178      {
    169179        <In-Table? &RFP-Options TPP> = TFUNC;
    170         <RFP-Error (<Token-Position>) ("Incorrect using of t-function \n")>,
     180        <Add-Error (<Token-Position>) ("Incorrect using of t-function \n")>,
    171181          TFUNC;
    172182      };
     
    322332              '\'' = (e.s '\'') (e.rest2) T;
    323333              '\"' = (e.s '\"') (e.rest2) T;
    324               s = <RFP-Warning (<Token-Position>)
    325                 ("Unknown control sequence \'\\" s.first2 "\'")>,
     334              s = <Add-Warning (<Token-Position>) ("Unknown control sequence \'\\" s.first2 "\'")>,
    326335                (e.s s.first2) (e.rest2) T;
    327336            };
    328337          (e.s) (<Get-Source-Line>) T;
    329           <RFP-Error (<Token-Position>) (Error "Unterminated string detected")>,
     338          <Add-Error (<Token-Position>) (Error "Unterminated string detected")>,
    330339            (e.s) () F;
    331340        };
     
    333342      };
    334343    (e.s '\n') (<Get-Source-Line>) T;
    335     <RFP-Error (<Token-Position>) ("Unterminated string detected")>,
     344    <Add-Error (<Token-Position>) ("Unterminated string detected")>,
    336345      (e.s) () F;
    337346  } :: (e.s) (e.l) s.cond,
     
    342351  e.line : e1 '*/' e.rest = <Map &Apply (<Replicate <Length e1 '*/'> &Next-Column>)> : e, e.rest;
    343352  <Skip-Comment <Get-Source-Line>>;
    344   <RFP-Error (<Token-Position>) ("Unexpected end of file")>;
     353  <Add-Error (<Token-Position>) ("Unexpected end of file")>;
    345354};
    346355
  • to-imperative/trunk/compiler/rfp_lex.rfi

    r2447 r2465  
    1818// $Id$
    1919
    20 $func RFP-Lexer e.filename = e.tokens ;
     20$func? RFP-Lexer e.source = e.tokens ;
     21$func RFP-Lexer-Errors = e.errors ;
  • to-imperative/trunk/compiler/rfp_parse.rf

    r2448 r2465  
    7070$box Token-Stack ;
    7171$table Names ;
    72 
    7372$box Traceall? ;
     73$box Errors ;
     74
     75$func Add-Error (e.position) (e.message) = ;
     76$func Add-Warning (e.position) (e.message) = ;
     77
     78RFP-Parser-Errors = <? &Errors>;
     79
     80Add-Error (e.position) (e.message) = <Put &Errors (ERROR ((<? &Current-Module>) (e.position)) (e.message))>;
     81
     82Add-Warning (e.position) (e.message) = <Put &Errors (WARNING ((<? &Current-Module>) (e.position)) (e.message))>;
     83
     84$func Add-Errors e.errors = ;
     85Add-Errors e.errors,
     86  { e.errors : e ((e.position) (e.message)) e, <Add-Error (e.position) (e.message)>, $fail;;};
     87
     88$func Add-Warnings e.errors = ;
     89Add-Warnings e.warnings,
     90  { e.warnings : e ((e.position) (e.message)) e, <Add-Warning (e.position) (e.message)>, $fail;;};
    7491
    7592// This function returns a token description according
     
    112129// This function returns a next token
    113130Get-Token // [] = (e.pos) (s.type e.value)
    114  = {
    115    <? &Token-Stack> : (e.token) e.rest,
    116      <Store &Token-Stack e.rest> = e.token : (e.pos) (s.type e.value),
    117      (e.pos) (s.type e.value);
    118  };
     131  = <? &Token-Stack> : (e.token) e.rest,
     132  <Store &Token-Stack e.rest>,
     133  e.token : (e.pos) (s.type e.value),
     134  (e.pos) (s.type e.value);
    119135
    120136// This function puts a token to unget stack for future use
     
    134150        s.message : T;
    135151        s.type : EOF;
    136       }, <RFP-Error (e.pos) ("Unexpected " <Token-Descr s.type>)>, $fail;
     152      }, <Add-Error (e.pos) ("Unexpected " <Token-Descr s.type>)>, $fail;
    137153      F <Get-Token>;
    138154    } :: s.message (e.pos) (s.type e.value),
     
    151167  <Clear-Table &Names>,
    152168  {
    153     <RFP-Src-GetInterfaceReader t.fileId> :: e.reader =
    154       <RFP-Lexer e.reader> : e.tokens ((e)(EOF)), e.tokens;;
     169    <RFP-Src-GetImplementationReader t.fileId>;
     170    = <Add-Error (0 0) ("No file " t.fileId " body.")>, $fail;
     171  } :: e.reader (e.qname),
     172  <Store &Module-Name e.qname>,
     173  <Store &Current-Module RF e.qname>,
     174  {
     175    <RFP-Lexer e.reader>;
     176    = <Add-Error (0 0) ("This file can't be parsered")>,
     177      <Add-Errors <RFP-Lexer-Errors>>,
     178      $fail;
     179  } :: e.implem-tokens,
     180  <Add-Warnings <RFP-Lexer-Errors>>,
     181  <Store &Current-Module RFI e.qname>,
     182  {
     183    <RFP-Src-GetInterfaceReader t.fileId> :: e.reader = {
     184      <RFP-Lexer e.reader> : e.tokens ((e)(EOF)) =
     185        <Add-Warnings <RFP-Lexer-Errors>>,
     186        e.tokens;
     187      = <Add-Error (0 0) ("This file can't be parsered")>,
     188        <Add-Errors <RFP-Lexer-Errors>>,
     189        /*empry*/;
     190    };;
    155191  } :: e.interf-tokens,
    156   <RFP-Src-GetImplementationReader t.fileId> :: e.reader (e.qname),
    157   <Store &Module-Name e.qname>,
    158   <RFP-Lexer e.reader> :: e.implem-tokens,
    159192  <Put-Tokens (() (NAME RFI e.qname)) e.interf-tokens (() (NAME RF e.qname)) e.implem-tokens>,
    160   (MODULE (e.qname) <Parse-Body>);
    161 //  <Store &Unget-Stack>,
    162 //  <Store &Module-Name <RFP-Module-Name <Lookup &RFP-Sources 1>>>,
    163 //  $trap
    164 //    {
    165 //      <Interface?>,
    166 //        (INTERFACE <Make-Name <Module-Name>> <Parse-Body>);
    167 //      (MODULE <Make-Name <Module-Name>> <Parse-Body>);
    168 //    }
    169 //  $with {
    170 //    e = <? &Saved-Position> :: e.pos,
    171 //      <RFP-Error (e.pos) ("Unexpected end of file during declaration parsing")>,
    172 //      FAIL;
    173 //  };
    174 //  ;
     193  <Parse-Body> :: e.body,
     194  {
     195    <? &Errors> : e (ERROR e) e = $fail;
     196    (MODULE (e.qname) <Parse-Body>);
     197  };
    175198
    176199// The main parsing routine
     
    225248      <Lookup &Names e.name> : (e.decl-pos) (e.origname) s.tag s.linkage t.in t.out,
    226249      s.linkage : \{ LOCAL; EXPORT; } =
    227       <RFP-Warning (e.decl-pos) ("No defenition for the function '" e.name "'")>,
     250      <Add-Warning (e.decl-pos) ("No defenition for the function '" e.name "'")>,
    228251      e.rest
    229252      (e.undefs (UNDEF s.tag <Pragma e.decl-pos> (e.name) t.in t.out));
     
    239262    {
    240263      s.type : SEMICOLON = Stop e.tokens;
    241       s.itype : {
     264
     265      s.itype : \{
    242266        USE = <RFP-Src-GetInterfaceReaderForModule <Make-Name s.type e.origname>>;
    243267        IMPORT = <RFP-Src-GetInterfaceReaderForClass <Make-Name s.type e.origname>>;
    244268      } :: e.reader (e.qname),
    245         <RFP-Lexer e.reader> : e.toks ((e) (EOF)),
    246         Continue e.tokens (() (NAME RFI e.qname)) e.toks;
     269        {
     270          <RFP-Lexer e.reader> : e.toks ((e) (EOF)),
     271            <Add-Warnings <RFP-Lexer-Errors>>,
     272            Continue e.tokens (() (NAME RFI e.qname)) e.toks;
     273          <Add-Error (e.pos) ("Module "e.origname" can't be read")>,
     274            <Add-Errors <RFP-Lexer-Errors>>,
     275            Continue e.tokens;
     276        };
     277
     278      <Add-Warning (e.pos) ("Module "e.origname" can't be found")>,
     279        Continue e.tokens;
    247280    };
     281    <Add-Error (-1 -1) ("Semicolon expected")>,
     282      Stop e.tokens;
    248283  } :: s.stop? e.tokens,
    249284  s.stop? : Stop =
     
    384419            (e.pragma-pos) (e.origname) TFUNC e = e.qname;
    385420            (e.pragma-pos) (e.origname) s.decl e =
    386               <RFP-Error (e.pos) ("\'" e.origname "\' is not a function,")>,
    387               <RFP-Error (e.pragma-pos)
     421              <Add-Error (e.pos) ("\'" e.origname "\' is not a function,")>,
     422              <Add-Error (e.pragma-pos)
    388423                ("  '" e.origname "' is declared here as " s.decl)>;
    389424          };
    390425        <Canonical-Word 'Main'> e.qname : s1 e s1 =
    391426          e.qname;
    392         <RFP-Error (e.pos) ("Undefined name \'" e.origname "\'" )>;
     427        <Add-Error (e.pos) ("Undefined name \'" e.origname "\'" )>;
    393428      } :: e.qname,
    394429      {
     
    408443        {
    409444          e.nameinfo : (e) (e.origname) e (Def e.def-pos) =
    410             <RFP-Error (e.pos) ("Redefenition of function '" e.origname "',")>,
    411             <RFP-Error (e.def-pos) ("  previously defined here")>;;
     445            <Add-Error (e.pos) ("Redefenition of function '" e.origname "',")>,
     446            <Add-Error (e.def-pos) ("  previously defined here")>;;
    412447        },
    413448        e.nameinfo : {
     
    428463            e.qname TFUNC s.linkage t.in t.out <Pragma e.pragma-pos>;
    429464          (e.pragma-pos) (e.origname) s.decl e =
    430             <RFP-Error (e.pos) ("\'" e.origname "\' is not a function,")>,
    431             <RFP-Error (e.pragma-pos)
     465            <Add-Error (e.pos) ("\'" e.origname "\' is not a function,")>,
     466            <Add-Error (e.pragma-pos)
    432467                ("  '" e.origname "' is declared here as " s.decl)>,
    433468            <Bind &Names (e.qname)
     
    438473        <Bind &Names (e.qname) ((e.pos) (e.funcorigname) FUNC EXPORT () ((EVAR)) (Def e.pos))>,
    439474        e.qname FUNC EXPORT () ((EVAR)) <Pragma e.pos>;
    440       <RFP-Error (e.pos) ("Undefined name \'" e.funcorigname "\'" )>,
     475      <Add-Error (e.pos) ("Undefined name \'" e.funcorigname "\'" )>,
    441476        <Bind &Names (e.qname) ((e.pos) (e.funcorigname) FUNC LOCAL ((EVAR)) ((EVAR)) (Def e.pos))>,
    442477        e.qname FUNC LOCAL ((EVAR)) ((EVAR)) <Pragma e.pos>;
     
    623658                  TFUNC e;
    624659                };
    625               <RFP-Error (e.pos) ("\'" e.origname "\' is not a function")>,
    626                 <RFP-Error (e.decl-pos)
     660              <Add-Error (e.pos) ("\'" e.origname "\' is not a function")>,
     661                <Add-Error (e.decl-pos)
    627662                  ("  '" e.origname "' is declared here as "
    628663                    s.decl-type)>;
    629664            },
    630665            e.qname;
    631           <RFP-Error (e.pos) ("Undefined name \'" e.origname "\'" )>,
     666          <Add-Error (e.pos) ("Undefined name \'" e.origname "\'" )>,
    632667            <Decl-Name <Make-Name s.WORD-or-QWORD e.origname>> :: s e.qname,
    633668            e.qname;
     
    695730      <Lookup-Name (e.pos) (<Make-Name s.WORD-or-QWORD e.origname>)> :: e.qname =
    696731        (REF (e.qname));
    697       <RFP-Error (e.pos) ("Undefined name \'" e.origname"\'" )> =
     732      <Add-Error (e.pos) ("Undefined name \'" e.origname"\'" )> =
    698733        <Decl-Name <Make-Name s.WORD-or-QWORD e.origname>> :: s e.qname,
    699734        (REF (e.qname));
     
    705740    <Lookup &Names e.qname> : (e.prev-pos) e =
    706741      e.info : (e.origname) e,
    707       <RFP-Error (e.pos) ("Redeclaration of '" e.origname "',")>,
    708       <RFP-Error (e.prev-pos) ("  previously declared here")>;;
     742      <Add-Error (e.pos) ("Redeclaration of '" e.origname "',")>,
     743      <Add-Error (e.prev-pos) ("  previously declared here")>;;
    709744  },
    710745  <Bind &Names (e.qname) ((e.pos) e.info)>;
    711 
    712 Make-Name s.type e.origname,
    713   {
    714     s.type : WORD, <In-Table? &RFP-Options CASE-INSENSITIVE> = <To-Upper e.origname>;
    715     e.origname;
    716   } :: e.origname,
    717   <Concat <Map! &To-Word (<Separate ('.') e.origname>)>>;
    718746
    719747$func Lookup-Check (e.pos) (e.name) (e.qname) (e.rest) = ;
     
    736764        e (e.module e.name) e.rest = (e.module e.name) (e.rest);
    737765      } :: (e.other) (e.rest),
    738       <RFP-Error (e.pos)
     766      <Add-Error (e.pos)
    739767        ("Ambiguous name \'" e.name "\' - both \'"
    740768         e.qname "\' and \'"
  • to-imperative/trunk/compiler/rfp_parse.rfi

    r2447 r2465  
    2121// Author: Andrey Slepuhin <pooh@msu.ru>
    2222
    23 $func RFP-Parser t.fileId = t.as ;
    24 
    25 $func Make-Name s.type e.origname = e.name;
     23$func? RFP-Parser t.fileId = t.as ;
     24$func RFP-Parser-Errors = e.errors ;
  • to-imperative/trunk/compiler/rfpc.rf

    r2459 r2465  
    145145        e.ext : \{ ' .rf'; ' .rfi'; } =
    146146          <Verbose e.file ": parsing started" >,
    147           <RFP-Parser (e.file)> :: t.as,
     147          {
     148            <RFP-Parser (e.file)>;
     149            = <PrintLN! &StdErr "Errors in " e.file>,
     150              <RFP-Parser-Errors> : e (e.error) e,
     151              e.error : {
     152                ERROR ((e.efile) (s.row s.column)) (e.message) =
     153                  <PrintLN e.efile ": " s.row ", " s.column " --- Error: " e.message>;
     154                WARNING ((e.efile) (s.row s.column)) (e.message) =
     155                  <PrintLN e.efile ": " s.row ", " s.column " --- Warning: " e.message>;
     156              },
     157              <Compilation-Failed> 1;
     158          } :: t.as,
     159          <RFP-Parser-Errors> : e (e.error) e,
     160          e.error : {
     161            WARNING ((e.efile) (s.row s.column)) (e.message) =
     162              <PrintLN e.efile ": " s.row ", " s.column " --- Warning: " e.message>;
     163          },
    148164          <Verbose e.file ": parsing finished">,
    149165          AS-REFAL t.as;
Note: See TracChangeset for help on using the changeset viewer.