Changeset 963


Ignore:
Timestamp:
Jul 6, 2003, 7:03:26 AM (18 years ago)
Author:
orlov
Message:
  • Improved generation of names for auxiliary variables.
  • Print-Error function is moved from rfp_compile to rfp_check.
  • A bug in Split-Re function which caused $const'ants to be disclosed too early

in some cases is fixed.

Location:
to-imperative/trunk/compiler
Files:
6 edited

Legend:

Unmodified
Added
Removed

  • to-imperative/trunk/compiler/rfp_as2as.rf

    r793 r963  
    1818$func Unstick-Blocks e.Sentence = e.Sentence (e.Fe);
    1919
    20 $func Generate-In-Out-Vars (e.in) (e.out) e.branch = (e.in) (e.out) e.branch;
     20$func Generate-In-Vars (e.in) e.branch = (e.in) e.branch;
    2121
    2222// rename variables local for the {}-blocks
    … …  
    5353      <Unstick-Blocks e.branch> :: e.branch t,
    5454      {
    55         <Format-Exp e.in> : e.in, <Format-Exp e.out> : e.out =
    56           <Generate-In-Out-Vars (e.in) (e.out) e.branch>;
    57         (e.in) (e.out) e.branch;
    58       } :: (e.in) (e.out) e.branch,
     55        <Format-Exp e.in> : e.in =
     56          <Generate-In-Vars (e.in) e.branch>;
     57        (e.in) e.branch;
     58      } :: (e.in) e.branch,
    5959      <Rename-Vars 0 (<Vars e.in>) () e.branch> :: e.branch,
    6060      (s.link s.tag t.pragma t.name (e.in) (e.out) (BRANCH t.p e.branch));
    … …  
    114114
    115115/*
    116  * Generate variable names for input and output function parameters. Change
    117  * e.Sentence so that it doesn't begin with pattern.
     116 * Generate variable names for input function parameters. Change e.Sentence so
     117 * that it doesn't begin with pattern.
    118118 */
    119 Generate-In-Out-Vars (e.in) (e.out) e.Sentence, {
     119Generate-In-Vars (e.in) e.Sentence, {
    120120  /*
    121121   * If input PAlt of a function is a sentence (not a block), format of
    … …  
    136136        (e.Pe) e.Snt;
    137137      <Gener-Var-Indices 1 (e.in) "arg"> :: e.in-expr s =
    138         (e.in) (RESULT (PRAGMA) e.in-expr) e.Sentence;
     138        (e.in-expr) (RESULT (PRAGMA) e.in-expr) e.Sentence;
    139139    };
    140140  /*
    … …  
    159159    } :: (e.br) e.branches,
    160160    e.branches : /*empty*/ =
    161     (e.in) (s.block t.Pragma e.br) e.Snt;
     161    (e.in-expr) (s.block t.Pragma e.br) e.Snt;
    162162  /*
    163163   * Else sentence already hasn't begun with pattern, so left it as it is.
    … …  
    166166//!     (e.in) e.Sentence;
    167167} :: (e.in) e.Sentence =
    168 //  <Gener-Var-Indices 1 (e.out) "res"> :: e.out s,
    169   (e.in) (e.out) e.Sentence;
     168  (e.in) e.Sentence;
    170169
    171170/*
    … …  
    256255Old-Var? e.vars (s.tag t (e.QualifiedName)) = e.vars : e (s.tag t (e.QualifiedName)) e;
    257256
    258 Rename s.num (s.tag t.p (e.QualifiedName s.last)), {
    259   <Int? s.last> = (s.tag t.p ("renew_" e.QualifiedName s.last s.num));
    260   (s.tag t.p ("ren_" e.QualifiedName s.last s.num));
    261 };
     257Rename s.num (s.tag t.p (e.QualifiedName)) =
     258  (s.tag t.p (e.QualifiedName "_" s.num));
    262259
    263260/*

  • to-imperative/trunk/compiler/rfp_check.rf

    r683 r963  
    33// $Date$
    44
    5 $use Access Box Compare StdIO Table;
     5$use Access Arithm Box Compare Convert StdIO Table;
    66
    77$use "rfpc";
     8$use "rfp_err";
    89$use "rfp_compile";
    910$use "rfp_format";
    … …  
    2930// returns the maximum (by length) sequence of cuts contained in the argument
    3031$func? Get-Cuts t.Branch-or-Block = e.cuts-sequence;
     32
     33// Print error or warning message
     34$func Print-Error s.warning-or-error? e.description t.pragma = ;
     35
     36$func Print-Pragma s.channel t.Pragma = ;
     37
     38$func AS-To-Ref e.AS-Expr = e.Refal-Expr;
    3139
    3240
    … …  
    299307  e.cuts;
    300308
     309
     310
     311Print-Error s.WE e.Descrip t.Pragma =
     312  <? &Error-Counter> : s.n,
     313  <Store &Error-Counter <"+" s.n 1>>,
     314  <Print-Pragma &StdErr t.Pragma>,
     315  <Print! &StdErr " " s.WE " ">,
     316  s.WE e.Descrip : {
     317    Error! Re = <PrintLN! &StdErr "Wrong format of result expression">;
     318    Error! Call = <PrintLN! &StdErr "Wrong argument format in function call">;
     319    Error! Pattern = <PrintLN! &StdErr "Wrong format of pattern expression">;
     320    Warning! Pattern = <PrintLN! &StdErr "Clash can't be solved">;
     321    Error! Var-Re t.var =
     322      <PrintLN! &StdErr "Unknown variable '"
     323                <AS-To-Ref t.var> "' in result expression">;
     324    Error! Var-Hard t.var =
     325      <PrintLN! &StdErr "Repeated occurence of the variable '"
     326                <AS-To-Ref t.var> "' in hard expression">;
     327    Error! Var-Type t.var s.type =
     328      <PrintLN! &StdErr "Incorrect type '" <AS-To-Ref s.type>
     329                "' of the variable '" <AS-To-Ref t.var> "'">;
     330    Error! Cut = <PrintLN! &StdErr "'\\\\!' without corresponding '\\\\?'">;
     331  };
     332
     333Print-Pragma s.channel (PRAGMA e.pragmas),
     334  e.pragmas : {
     335    e (FILE e.file-name) e, <Print! s.channel e.file-name>, $fail;
     336    e (LINE s.line s.col) e, <Print! s.channel (s.line ", " s.col)>, $fail;
     337    e = <Print! s.channel ":">;
     338  };
     339
     340AS-To-Ref {
     341  SVAR = 's';
     342  TVAR = 't';
     343  VVAR = 'v';
     344  EVAR = 'e';
     345  (s.tag t (e.name)) = <AS-To-Ref s.tag> '.' <To-Chars e.name>;
     346};
     347

  • to-imperative/trunk/compiler/rfp_compile.rf

    r924 r963  
    44
    55$use "rfpc";
    6 $use "rfp_err";
    76$use "rfp_list";
    87$use "rfp_helper";
    … …  
    4241
    4342/*
    44  * Box for storing names for function input variables
    45  */
    46 $box Arg-Vars;
    47 
    48 /*
    4943 * Box for storing names for function result variables
    5044 */
    … …  
    5953$table Labels;
    6054
    61 //$box Var-Stack;
    62 $table Vars-Tab;
     55/*
     56 * Table for storing variables used in place of preprocessor-generated ones.
     57 */
     58$table Prep-Vars;
    6359
    6460$box Greater-Ineqs;
    … …  
    6965$func Compile (e.targets) (e.headers) e.Items = e.Compiled-Items (INTERFACE e.headers);
    7066
    71 $func Print-Pragma s.channel t.Pragma = ;
    72 
    73 $func AS-To-Ref e.AS-Expr = e.Refal-Expr;
    74 
    7567$func Length-of e.Re = e.length;
    7668
    … …  
    137129$func Comp-Calls e.Re = e.calls;
    138130
    139 $func Comp-Static-Exprs e.Reult-exprs = e.Result-exprs;
     131$func Prepare-Vars e.vars = e.vars;
     132
     133$func Prepare-Res e.Reult-exprs = e.Result-exprs;
    140134
    141135$func Comp-Assigns e.assignments = e.asail-assignments;
    … …  
    233227  <Store &Greater-Ineqs /*empty*/>,
    234228  <Store &Less-Ineqs /*empty*/>,
    235 //!     <RFP-Clear-Table &Vars-Tab>,
     229  <RFP-Clear-Table &Prep-Vars>,
    236230  <Init-Vars>,
    237231//!     <Ref-To-Var e.Sentence> :: e.Sentence,
    238 //!     <Store-Vars <Vars e.out>> :: e.res-vars,
    239232  <Vars <Gener-Vars (e.out) "res">> :: e.res-vars,
    240233  <Vars-Decl e.res-vars> : e,
    241234  <Store &Res-Vars e.res-vars>,
    242235  <Store &Out-Format <Format-Exp e.out>>,
    243   <Gener-Vars (e.in) "arg"> :: e.in,
    244   <Vars e.in> :: e.arg-vars,
    245   <Vars-Decl e.arg-vars> : e, // ???
     236  <Prepare-Res (e.in)> : (e.arg),
     237  <Vars e.arg> :: e.arg-vars,
    246238  <Map &Set-Var- (Instantiated? True) (e.arg-vars)> : e,
    247   <Store &Arg-Vars e.arg-vars>,
    248239  s.tag : {
    249240    FUNC = FATAL;
    … …  
    251242  } :: t.retfail,
    252243  (FUNC t.name (<Vars-Print e.arg-vars>) (<Vars-Print e.res-vars>)
    253     <Comp-Sentence Tail ((t.retfail)) (e.in) e.Sentence>
     244    <Comp-Sentence Tail ((t.retfail)) (e.arg) e.Sentence>
    254245  ) :: e.comp-func,
    255246*       <Set-Drops () <Gener-Var-Names e.comp-func>> :: t e.comp-func,
    … …  
    363354        <Subformat? (e.Fout) (<? &Out-Format>)> =
    364355        <Extract-Calls e.arg> :: (e.last-Re) e.calls,
    365         <Comp-Static-Exprs <Split-Re (e.Fin) e.last-Re>> :: e.splited-Re,
     356        <Prepare-Res <Split-Re (e.Fin) e.last-Re>> :: e.splited-Re,
    366357        <Comp-Calls <R 0 v.fails> e.calls>
    367358        (TAILCALL t.name (e.splited-Re) (<? &Res-Vars>));
    … …  
    372363          e.Snt : /*empty*/, s.tail? : Tail =
    373364            <Split-Re (<? &Out-Format>) e.last-Re> :: e.splited-Re,
    374             <Comp-Static-Exprs e.splited-Re> :: e.splited-Re,
     365            <Prepare-Res e.splited-Re> :: e.splited-Re,
    375366            e.comp-calls <Comp-Assigns <Zip (<? &Res-Vars>) (e.splited-Re)>>;
    376367
    … …  
    437428        (FORMAT e.format) = e.format;
    438429      } :: e.expr =
    439         <Vars e.expr> :: e.vars,
     430        <Prepare-Vars <Vars e.expr>> :: e.vars,
    440431*                               <New-Vars e.vars>,
    441432        (<Vars-Decl e.vars>) ((Comp If-not-error) t.first)
    … …  
    454445     */
    455446    {
    456       \{ e.source? : v; e.Snt : v; } = ((Comp Source)) Notail;
     447      \{ e.source? : v; e.Snt : v; } = ((Comp Source) <R 0 v.fails>) Notail;
    457448      s.tail? : Tail = () Tail;
    458449      () Notail;
    … …  
    627618
    628619  (Comp Error) e.Snt =
    629     <Comp-Static-Exprs (e.last-Re)> : (e.Re),
     620    <Prepare-Res (e.last-Re)> : (e.Re),
    630621    (ERROR e.Re);
    631622
    … …  
    685676    <Lookup-Func t.name> :: s.linkage s.tag t.pragma (e.Fin) (e.Fout),
    686677    <Extract-Calls e.arg> :: (e.last-Re) e.calls,
    687     <Comp-Static-Exprs <Split-Re (e.Fin) e.last-Re>> :: e.splited-Re,
     678    <Prepare-Res <Split-Re (e.Fin) e.last-Re>> :: e.splited-Re,
    688679    <RFP-Extract-Qualifiers t.name> :: t e.prefix,
    689680*               <Del-Pragmas <Gener-Vars 0 (e.Fout) e.prefix>> : e.Re s,
    … …  
    722713
    723714
     715********** Preparation of vars and REs for following processing **********
    724716*********** Compilation of static parts of result expressions ************
    725717
    … …  
    731723/*
    732724 * Extract static parts from each Re.
    733  * Also get the right names of arg-variables, if those are in the expr.
    734  * FIXME: the function should be renamed.  In something reflecting expression
    735  * preparing for following doings.
    736  */
    737 Comp-Static-Exprs {
    738   (e.Re) e.rest = <Static-Expr? Create e.Re> :: s e.Re, (e.Re) <Comp-Static-Exprs e.rest>;
     725 * Also get the right names for variables generated during the preprocessing
     726 * stage, if those are in the expr.
     727 */
     728Prepare-Res {
     729  (e.Re) e.rest = <Static-Expr? Create e.Re> :: s e.Re, (e.Re) <Prepare-Res e.rest>;
    739730  /*empty*/     = /*empty*/;
    740731};
    741 
    742732
    743733/*
    … …  
    776766  (PAREN e.Re) = <Static-Expr? Not-Create e.Re> :: static? e.Re, static? (PAREN e.Re);
    777767  (REF t.name) = Static (REF t.name);
    778   (s.var-tag ("arg" s.n)) = Dynamic <L <"-" s.n 1> <? &Arg-Vars>>;
    779   t.var        = Dynamic t.var;
     768  t.var        = <Prepare-Vars t.var> : t.prep-var, Dynamic t.prep-var;
     769};
     770
     771
     772Prepare-Vars {
     773  (s.var-tag (e.prefix s.n)) e.rest, <Int? s.n> =
     774    {
     775      <Lookup &Prep-Vars e.prefix s.n>;
     776      <Gener-Vars ((s.var-tag)) e.prefix> :: e.var,
     777//        <WriteLN Prep-Var (s.var-tag (e.prefix s.n)) e.var>,
     778        <Bind &Prep-Vars (e.prefix s.n) (e.var)>,
     779        e.var;
     780    } :: e.var,
     781    e.var <Prepare-Vars e.rest>;
     782  t.var e.rest = t.var <Prepare-Vars e.rest>;
     783  /*empty*/ = /*empty*/;
    780784};
    781785
    … …  
    787791
    788792Comp-Assign-to-Var (t.var (e.Re)) =
    789   <Set-Var (Instantiated? True) t.var>,
    790793  {
    791794    t.var : e.Re = /*empty*/;
    792     <Generated-Var? e.Re> = <Gener-Var-Assign t.var e.Re>;
     795    <Generated-Var? e.Re>, # \{ <Get-Var Instantiated? t.var> : True; } =
     796      <Gener-Var-Assign t.var e.Re>;
     797    <Set-Var (Instantiated? True) t.var>, $fail;
    793798    <Get-Var Decl t.var> : s = (ASSIGN <Vars-Print t.var> e.Re);
    794799    <Vars-Decl t.var> : e, (EXPR <Vars-Print t.var> e.Re);
    … …  
    815820
    816821Comp-Format (e.last-Re) e.He =
    817   <Vars e.He> :: e.vars,
    818   <Comp-Static-Exprs <Split-Re (<Format-Exp e.He>) e.last-Re>> :: e.splited-Re,
     822  <Prepare-Vars <Vars e.He>> :: e.vars,
     823  <Prepare-Res <Split-Re (<Format-Exp e.He>) e.last-Re>> :: e.splited-Re,
    819824  <Store &Aux-Index 1>,
    820825  <Create-Aux-Vars (e.vars) e.splited-Re> :: e.assigns,
    … …  
    10551060       * на предмет клешей, в которых они раньше использовались.
    10561061       */
    1057       <Comp-Static-Exprs (e.Re) (e.Pe)> : (e.R1) (e.P1),
     1062      <Prepare-Res (e.Re) (e.Pe)> : (e.R1) (e.P1),
    10581063      <Map &Set-Var- (Clashes /*empty*/) (<Vars e.R1 e.P1>)> : e,
    10591064      (e.clashes (e.R1) (s.dir e.P1)) e.rest;
    … …  
    19441949
    19451950
    1946 Print-Error s.WE e.Descrip t.Pragma =
    1947   <? &Error-Counter> : s.n,
    1948   <Store &Error-Counter <"+" s.n 1>>,
    1949   <Print-Pragma &StdErr t.Pragma>,
    1950   <Print! &StdErr " " s.WE " ">,
    1951   s.WE e.Descrip : {
    1952     Error! Re = <PrintLN! &StdErr "Wrong format of result expression">;
    1953     Error! Call = <PrintLN! &StdErr "Wrong argument format in function call">;
    1954     Error! Pattern = <PrintLN! &StdErr "Wrong format of pattern expression">;
    1955     Warning! Pattern = <PrintLN! &StdErr "Clash can't be solved">;
    1956     Error! Var-Re t.var =
    1957       <PrintLN! &StdErr "Unknown variable '"
    1958                 <AS-To-Ref t.var> "' in result expression">;
    1959     Error! Var-Hard t.var =
    1960       <PrintLN! &StdErr "Repeated occurence of the variable '"
    1961                 <AS-To-Ref t.var> "' in hard expression">;
    1962     Error! Var-Type t.var s.type =
    1963       <PrintLN! &StdErr "Incorrect type '" <AS-To-Ref s.type>
    1964                 "' of the variable '" <AS-To-Ref t.var> "'">;
    1965     Error! Cut = <PrintLN! &StdErr "'\\\\!' without corresponding '\\\\?'">;
    1966   };
    1967 
    1968 Print-Pragma s.channel (PRAGMA e.pragmas),
    1969   e.pragmas : {
    1970     e (FILE e.file-name) e, <Print! s.channel e.file-name>, $fail;
    1971     e (LINE s.line s.col) e, <Print! s.channel (s.line ", " s.col)>, $fail;
    1972     e = <Print! s.channel ":">;
    1973   };
    1974 
    1975 AS-To-Ref {
    1976   SVAR = 's';
    1977   TVAR = 't';
    1978   VVAR = 'v';
    1979   EVAR = 'e';
    1980   (s.tag t (e.name)) = <AS-To-Ref s.tag> '.' <To-Chars e.name>;
    1981 };
    1982 
    19831951Lookup-Func t.Fname, \{
    19841952  <Lookup &Fun t.Fname>;

  • to-imperative/trunk/compiler/rfp_compile.rfi

    r881 r963  
    1818$table Object;
    1919
    20 // Print error or warning message
    21 $func Print-Error s.warning-or-error? e.description t.pragma = ;
    22 
    2320
    2421

  • to-imperative/trunk/compiler/rfp_format.rf

    r901 r963  
    4848      // (BLOCK e.Branches) = ...
    4949      (PAREN e.Expression) = (PAREN <Format-Exp e.Expression>);
    50       (VAR t.name) = <?? t.name Format>;
     50      (VAR t.name) = $fail;
    5151      (s.VariableTag e) = (s.VariableTag); // s.VariableTag ::= SVAR | TVAR
    5252    } :: e.first-format =          //         | VVAR | EVAR
    … …  
    9191    <Split-Re (v.Fe <Middle 3 0 <Lookup &Const t.name>>) e.Re>;
    9292  };
     93  ((VVAR)) e.Re = (e.Re);
     94  ((EVAR)) e.Re = (e.Re);
    9395  (e.Fe) t.Rt e.Re, <Format-Exp t.Rt> : (REF t.name) =
    9496    <Split-Re (e.Fe) <Middle 3 0 <Lookup &Const t.name>> e.Re>;
    9597  (e.Fe) v.Re t.Rt, <Format-Exp t.Rt> : (REF t.name) =
    9698    <Split-Re (e.Fe) v.Re <Middle 3 0 <Lookup &Const t.name>>>;
    97   ((VVAR)) e.Re = (e.Re);
    98   ((EVAR)) e.Re = (e.Re);
    9999  () /*empty*/ = /*empty*/;
    100100};

  • to-imperative/trunk/compiler/rfp_vars.rf

    r924 r963  
    4646
    4747
    48 
    49 //! $func Create-Var e = e;
    50 
    51 //! New-Vars e.vars = <Map &Create-Var (e.vars)> : e;
    52 
    53 //! Create-Var t.var, t.var : {
    54 //!     (SVAR t.name) = <Put &State (t.var (SVAR) (1) (1) Non-Declared Non-Instantiated)>;
    55 //!     (TVAR t.name) = <Put &State (t.var (TVAR) (1) (1) Non-Declared Non-Instantiated)>;
    56 //!     (VVAR t.name) = <Put &State (t.var (VVAR) (1) ( ) Non-Declared Non-Instantiated)>;
    57 //!     (EVAR t.name) = <Put &State (t.var (EVAR) (0) ( ) Non-Declared Non-Instantiated)>;
    58 //!     ( VAR t.name) = <Put &State (t.var (VAR)  (0) ( ) Non-Declared Non-Instantiated)>;
    59 //! };
    6048
    6149$func Normalize-Info e.info t.var = ;
    … …  
    216204
    217205/*
    218  * Convert FORMAT to RESULT expression by giving a name to each format
    219  * variable. In FORMAT may meet normal variables, they are not changed.
    220  * Resulting expression is generated without pragmas, so it can't be used in
    221  * the abstract syntax.
    222  * Return all variables from generated expression and the expression.
    223206 */
    224207Gener-Vars (e.format) e.prefix =
    225 *       <Gener-Var-Indices <Free-Index e.prefix> (e.format) e.prefix> :: e.Re s.max-index,
    226 *       <Set-Index (e.prefix) s.max-index>,
    227 *       <Del-Pragmas e.Re> :: e.Re,
    228208  {
    229209    e.format : (s.tag) e.Fe, {
    … …  
    238218    /*empty*/;
    239219  };
    240 *       <Vars e.Re> :: e.vars,
    241 *       <New-Vars e.vars>,
    242 *       (e.vars) e.Re;
    243220
    244221Gener-Err-Var = (EVAR <Box 2>);
    … …  
    248225
    249226
     227/*
     228 * (s.tag s.box) -- сгенерированная ранее переменная.
     229 * Вместо того, чтобы присвоить её значение переменной t.var, мы подставляем
     230 * t.var во все места, гда была использована (s.tag s.box).  Таким образом,
     231 * t.var получит нужное значение в тот момент, когда выполняется присваивание в
     232 * (s.tag s.box).
     233 * Если переменная t.var уже была ранее декларирована, чтобы избежать повторной
     234 * декларации, делаем декларацию для (s.tag s.box) пустой.
     235 * Если же переменная t.var -- новая, то её декларацией становится декларация
     236 * (s.tag s.box).
     237 */
    250238Gener-Var-Assign t.var (s.tag s.box) =
    251239  <Store s.box <Print-Var t.var>>,
    … …  
    253241    <Get-Var Decl t.var> : s =
    254242      <Get-Var Decl (s.tag s.box)> : s.decl-box,
    255       <Store s.decl-box /*empty*/>;;
     243      <Store s.decl-box /*empty*/>;
     244    <Set-Var (Decl <Get-Var Decl (s.tag s.box)>) t.var>;
    256245  };
    257246
    … …  
    330319      (PAREN expr) <Gener-Var-Indices s.num (e.rest) e.prefix>;
    331320    (s.VariableTag) =
    332       (VAR (PRAGMA) (e.prefix s.num)) :: t.var,
     321      (s.VariableTag (PRAGMA) (e.prefix s.num)) :: t.var,
    333322      <"+" s.num 1> :: s.num,
    334323      t.var <Gener-Var-Indices s.num (e.rest) e.prefix>;
Note: See TracChangeset for help on using the changeset viewer.