Changeset 3681


Ignore:
Timestamp:
Apr 7, 2008, 6:51:00 PM (13 years ago)
Author:
orlov
Message:
  • Declarations can go anywhere before or after defenitions and uses (doesn't work with $native yet).
File:
1 edited

Legend:

Unmodified
Added
Removed
  • to-imperative/trunk/compiler/refal/org/refal/plus/compiler/rfp_parse.rf

    r3589 r3681  
    1818$func Parse_Func_Decl s.type = e.items ;
    1919$func Parse_Trace_Names = e.trace_directives ;
    20 $func Parse_Func_Def (e.pos) (s.type e.value) = e.items ;
     20$func Check_Trace_Name ((e.pos) (s.WORD_or_QWORD e.origtracename)) = ;
     21$func Parse_Func_Def (e.pos) (s.type e.value) = ;
     22$func Output_Func_Def (e.pos) (s.WORD_or_QWORD e.funcorigname) t.branch = e.items;
    2123$func? IsTail = ;
    2224$func Parse_Path = e.items ;
     
    4648
    4749$func Bind_Name (e.qname) ((e.pos) e.info) = ;
    48 $func Lookup_Name (e.pos) (s.WORDorQWORD e.origName) = e.qname ;
     50$func Lookup_Names e.tree = e.tree;
    4951$func? Make_Decl_Name s.WORDorQWORD e.origName = s.linkage e.qname;
    5052$func Canonical_Word e.value = s.word;
     
    6163$table Upper_Names ;
    6264$table ImplemNames ;
     65$table FuncDefs ;
     66$box TraceNames ;
    6367$box IsTraceall ;
    6468$box Errors ;
     
    173177  <Store &Token_Stack>,
    174178  <ClearTable &ImplemNames>,
     179  <ClearTable &FuncDefs>,
     180  <Store &TraceNames>,
    175181  <Store &Current_Module RF t.fileId>,
    176182  <GetImplementationReader t.fileId> :: (e.qname) (e.interf_reader) (e.implem_reader),
     
    265271  // check for undefined functions.
    266272  <Get &Current_Module> : RFI e = F;
    267   <Domain &Names> (/*e.undefs*/) $iter {
    268     e.domain : e (e.name) e.rest,
    269       <Lookup &Names e.name> : (e.decl_pos) (e.origname) s.tag s.linkage t.in t.out,
    270       s.linkage : \{ LOCAL; EXPORT; } =
    271       <Add_Warning (e.decl_pos) ("No definition for the function '" e.origname "'")>,
    272       e.rest
    273       (e.undefs (UNDEF s.tag <Pragma e.decl_pos> (e.name) t.in t.out));
    274     /*empty*/ (e.undefs);
    275   } :: e.domain (e.undefs),
     273  <Entries &FuncDefs> (/*e.defs*/) $iter {
     274    e.funcdefs : (((e.pos) (s.WORD_or_QWORD e.funcorigname)) (t.branch)) e.rest =
     275      e.rest (e.defs <Output_Func_Def (e.pos) (s.WORD_or_QWORD e.funcorigname) t.branch>);
     276    (e.defs);
     277  } :: e.funcdefs (e.defs),
     278    e.funcdefs : /*empty*/ =
     279    <Domain &Names> (/*e.undefs*/) $iter {
     280      e.domain : e (e.name) e.rest,
     281        <Lookup &Names e.name> : (e.decl_pos) (e.origname) s.tag s.linkage t.in t.out,
     282        s.linkage : \{ LOCAL; EXPORT; } =
     283        <Add_Warning (e.decl_pos) ("No definition for the function '" e.origname "'")>,
     284        e.rest
     285        (e.undefs (UNDEF s.tag <Pragma e.decl_pos> (e.name) t.in t.out));
     286      /*empty*/ (e.undefs);
     287    } :: e.domain (e.undefs),
    276288    e.domain : /*empty*/ =
    277     e.undefs F;
     289    <Map &Check_Trace_Name (<Get &TraceNames>)> : e,
     290    <Lookup_Names e.defs> e.undefs F;
    278291};
    279292
     
    364377    e (SEMICOLON) = ;
    365378    (e.pos) (s.WORD_or_QWORD e.origtracename) =
     379      <Put &TraceNames ((e.pos) (s.WORD_or_QWORD e.origtracename))>,
    366380      <Make_Decl_Name s.WORD_or_QWORD e.origtracename> :: s e.qname,
    367       {
    368         <Lookup &Names e.qname> : (e.declPos) (e.origDeclName) s.declType e,
    369           {
    370             # s.declType : \{ FUNC; "FUNC?"; TFUNC; },
    371               <Add_Error (e.pos) ("\'" e.origtracename "\' is not a function")>,
    372               <Add_Error (e.declPos) ("  '" e.origDeclName "' is declared here as " s.declType)>;;
    373           };
    374         <Canonical_Word 'Main'> e.qname : s1 e s1;
    375         <Add_Error (e.pos) ("Undefined name \'" e.origtracename "\'" )>;
    376       },
    377381      (TRACE (e.qname)) <Parse_Trace_Names>;
     382  };
     383
     384Check_Trace_Name ((e.pos) (s.WORD_or_QWORD e.origtracename)) =
     385  <Make_Decl_Name s.WORD_or_QWORD e.origtracename> :: s e.qname,
     386  {
     387    <Lookup &Names e.qname> : (e.declPos) (e.origDeclName) s.declType e,
     388      {
     389        # s.declType : \{ FUNC; "FUNC?"; TFUNC; },
     390          <Add_Error (e.pos) ("\'" e.origtracename "\' is not a function")>,
     391          <Add_Error (e.declPos) ("  '" e.origDeclName "' is declared here as " s.declType)>;;
     392      };
     393    <Canonical_Word 'Main'> e.qname : s1 e s1;
     394    <Add_Error (e.pos) ("Undefined name \'" e.origtracename "\'" )>;
    378395  };
    379396
     
    435452  (e.pos) (s.WORD_or_QWORD e.funcorigname) =
    436453//<WriteLN Parse-Func-Def>,
    437     <Parse_Sentence> :: e.items,
    438     <Expect_Token SEMICOLON> : e,
     454  <Parse_Sentence> :: e.items,
     455  <Expect_Token SEMICOLON> : e,
     456  <Bind &FuncDefs ((e.pos) (s.WORD_or_QWORD e.funcorigname)) ((BRANCH <Pragma e.pos> e.items))>;
     457
     458Output_Func_Def (e.pos) (s.WORD_or_QWORD e.funcorigname) t.branch =
    439459    <Make_Decl_Name s.WORD_or_QWORD e.funcorigname> :: s e.qname,
    440460    {
     
    470490      s.linkage;
    471491    } :: s.linkage,
    472     (s.linkage s.tag t.pragma (e.qname) t.in t.out
    473       (BRANCH <Pragma e.pos> e.items)
    474     )
    475     e.trace;
     492    (s.linkage s.tag t.pragma (e.qname) t.in t.out t.branch) e.trace;
    476493
    477494IsTail // [] = []
     
    702719        {
    703720          <Get_Expected_Token WORD QWORD> :: (e.pos) (s.WORDorQWORD e.origCallName),
    704           <Lookup_Name (e.pos) (s.WORDorQWORD e.origCallName)> :: e.qname,
    705           {
    706             <Lookup &Names e.qname> : (e.declPos) (e.origDeclName) s.declType e,
    707               # s.declType : \{ FUNC; "FUNC?"; TFUNC; },
    708               <Add_Error (e.pos) ("\'" e.origCallName "\' is not a function")>,
    709               <Add_Error (e.declPos) ("  '" e.origDeclName "' is declared here as " s.declType)>;;
    710           }, e.qname;
     721            (STUB_NAME CALL (e.pos) (s.WORDorQWORD e.origCallName));// :: e.qname,
    711722          <Add_Error (e.pos) (<Token_Descr LBRACKET>" should be followed by an identifier")>;
    712723        } :: e.qname,
     
    756767      REF =
    757768      {
    758         (REF (<Lookup_Name <Get_Expected_Token WORD QWORD>>));
     769        (REF (STUB_NAME REF <Get_Expected_Token WORD QWORD>));
    759770        <Add_Error (e.pos) (<Token_Descr REF>" should be followed by an identifier")>;
    760771      };
     
    772783  <Bind &Names (e.qname) ((e.pos) e.info)>;
    773784
    774 Lookup_Name (e.pos) (s.WORDorQWORD e.origName) =
    775   <Make_Name e.origName> :: e.name,
    776   {
    777     \{
    778       s.WORDorQWORD : WORD, <IsInTable &RFP_Options "CASE-INSENSITIVE"> =
    779         e.name : e.m s.n,
    780         e.m <ToWord <ToUpper <ToChars s.n>>> :: e.name,
    781         <Domain &Upper_Names> : e (e.module e.name) e.rest =
    782         (<Lookup &Upper_Names e.module e.name>) (e.name) e.rest;
    783       <Domain &Names> : e (e.module e.name) e.rest =
    784         (e.module e.name) (e.name) e.rest;
    785     } :: (e.qname) (e.name) e.rest =
    786       {
    787         e.rest : e (e.module2 e.name) e,
    788           <Add_Error (e.pos)
     785Lookup_Names {
     786  (STUB_NAME s.tag (e.pos) (s.WORDorQWORD e.origName)) e.rest_terms =
     787    <Make_Name e.origName> :: e.name,
     788    {
     789      \{
     790        s.WORDorQWORD : WORD, <IsInTable &RFP_Options "CASE-INSENSITIVE"> =
     791          e.name : e.m s.n,
     792          e.m <ToWord <ToUpper <ToChars s.n>>> :: e.name,
     793          <Domain &Upper_Names> : e (e.module e.name) e.rest =
     794          (<Lookup &Upper_Names e.module e.name>) (e.name) e.rest;
     795        <Domain &Names> : e (e.module e.name) e.rest =
     796          (e.module e.name) (e.name) e.rest;
     797      } :: (e.qname) (e.name) e.rest =
     798        {
     799          e.rest : e (e.module2 e.name) e,
     800            <Add_Error (e.pos)
    789801            ("Ambiguous name \'" e.origName "\' - both \'"
    790               <Print_Name e.qname> "\' and \'"
    791               <Print_Name e.module2 e.name> "\' do exist")>,
    792           $fail;;
    793       },
    794       e.qname;
    795     <Add_Error (e.pos) ("Undefined name \'" e.origName "\'" )>,
    796       e.name;
    797   };
     802            <Print_Name e.qname> "\' and \'"
     803            <Print_Name e.module2 e.name> "\' do exist")>,
     804            $fail;;
     805        },
     806        e.qname;
     807      <Add_Error (e.pos) ("Undefined name \'" e.origName "\'" )>,
     808        e.name;
     809    } :: e.qname,
     810    {
     811      s.tag : CALL,
     812        <Lookup &Names e.qname> : (e.declPos) (e.origDeclName) s.declType e,
     813        # s.declType : \{ FUNC; "FUNC?"; TFUNC; },
     814        <Add_Error (e.pos) ("\'" e.origName "\' is not a function")>,
     815        <Add_Error (e.declPos) ("  '" e.origDeclName "' is declared here as " s.declType)>;;
     816    },
     817    e.qname <Lookup_Names e.rest_terms>;
     818  (e.expr) e.rest_terms = (<Lookup_Names e.expr>) <Lookup_Names e.rest_terms>;
     819  s.symbol e.rest_terms = s.symbol <Lookup_Names e.rest_terms>;
     820  /*empty*/ = /*empty*/;
     821};
    798822
    799823Make_Decl_Name s.WORDorQWORD e.origName =
Note: See TracChangeset for help on using the changeset viewer.