Changeset 2347


Ignore:
Timestamp:
Feb 7, 2007, 9:39:21 PM (14 years ago)
Author:
orlov
Message:
  • Advances in Java-bytecode generation.
Location:
to-imperative/trunk/compiler
Files:
2 edited

Legend:

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

    r2346 r2347  
    66$use "rfp_helper";
    77
     8$import "java.lang.Integer";
    89$import "org.objectweb.asm.ClassWriter";
    910$import "org.objectweb.asm.FieldVisitor";
     
    3637$func Module-To-JBC s.cw e.module = ;
    3738
    38 $func Func-To-JBC s.mv e.body = ;
    39 
    40 $func ASAIL-To-JBC e.body = e.java-code;
    41 
    42 $func Expr-To-JBC (e.ASAIL-Expr-init ) e.ASAIL-Expr-rest = e.aux-arrays (e.java-expr);
    43 
    44 $func Expr-Ref-To-JBC e.ASAIL-Expr-Ref = e.aux-arrays (e.JAVA-Expr-Ref);
    45 
    46 $func Expr-Int-To-JBC s.acc e.ASAIL-Expr-Int = e.JAVA-Expr-Int;
     39$func ASAIL-To-JBC e.body = ;
     40
     41$func ASAIL-To-JBC-Temp e.body = e.java-code;
     42
     43$func Expr-Ref-To-JBC e.ASAIL-Expr-Ref = ;
     44
     45$func Expr-Int-To-JBC e.ASAIL-Expr-Int = ;
    4746
    4847$func Step-To-JBC e.step-operators = e.java-step-operators;
     
    5453$func Int-Args-To-JBC s.acc e.args = e.java-args;
    5554
    56 $func Var-Args-To-JBC e.args = e.java-args;
    57 
    5855$func Symbol-To-JBC s.RFP-Symbol = e.JAVA-String;
    5956
    6057$func Name-To-JBC t.name = e.JAVA-Name;
    6158
    62 $func Var-To-JBC t.var = e.java-var;
     59$func Var-To-JBC t.var = ;
    6360
    6461$func Cond-To-JBC s.acc e.cond = e.JAVA-Cond;
    6562
    66 $func Infix-To-JBC s.acc s.func-for-converting-args-to-java s.op e.args = e.java-expr;
    67 
    68 $func Op-Arg-To-JBC s.op = s.func-for-converting-args-to-java;
     63$func Infix-To-JBC s.func-for-converting-args-to-java s.op e.args = ;
    6964
    7065$func Access-Mode t.name = s.jbc-access-mode;
     
    9590  <Store &Module-Name <Intersperse ('.') e.java-module-name>>,
    9691  <ClassWriter <"+" &"COMPUTE_MAXS" &"COMPUTE_FRAMES">> :: s.cw,
    97   //<ASAIL-To-JBC s.cw e.module> : e,
     92  //<ASAIL-To-JBC-Temp s.cw e.module> : e,
    9893  /*{
    9994    <? &Entry-Name> : v.name =
     
    133128  s.i;
    134129
    135 Lookup-Var t.var = <Lookup &Vars t.var> : s.type s.i = s.type s.i;
     130Lookup-Var t.var = {
     131  <Lookup &Vars t.var> : s.type s.i = s.type s.i;
     132  Expr 0; // TODO - remove
     133};
    136134
    137135$table Labels;
     
    146144
    147145Lookup-Label t.label = <Lookup &Labels t.label> : s.l = s.l;
     146
     147$box MVbox;
     148
     149$func MV = s;
     150
     151MV, <? &MVbox> : s.mv = s.mv;
    148152
    149153Module-To-JBC s.cw e.module, {
     
    163167      <To-Word '(' <Replicate <Length e.args> "Lorg/refal/plus/Expr;">
    164168        <Replicate <Length e.ress> "Lorg/refal/plus/Result;">')' s.retType> :: s.desc,
    165       <"visitMethod" s.cw s.accessMode s.funcName s.desc <Null> ("org/refal/plus/RefalException")> :: s.mv,
    166       <Func-To-JBC s.mv e.body>,
     169      <Store &MVbox <"visitMethod" s.cw s.accessMode s.funcName s.desc <Null> ("org/refal/plus/RefalException")>>,
     170      <ASAIL-To-JBC e.body>,
    167171      s.tag : {
    168         FUNC  = <MVvisitInsn s.mv &RETURN>;
    169         FUNC? = <MVvisitInsn s.mv &"ICONST_1"> <MVvisitInsn s.mv &IRETURN>;
     172        FUNC  = <MVvisitInsn <MV> &RETURN>;
     173        FUNC? = <MVvisitInsn <MV> &"ICONST_1"> <MVvisitInsn <MV> &IRETURN>;
    170174      },
    171       <MVvisitEnd s.mv>;
     175      <MVvisitEnd <MV>>;
    172176    (CONSTEXPR s.linkage t.name (e.comment) e.expr) =
    173177      <"+" &"ACC_STATIC" <"+" &"ACC_FINAL" <Access-Mode t.name>>> :: s.accessMode,
     
    199203};
    200204
    201 Func-To-JBC s.mv e.func-body, {
    202   e.func-body : e t.item e, t.item : {
     205ASAIL-To-JBC {
     206  e t.item e, <WriteLN> <WriteLN t.item > t.item : {
    203207    (DECL s.type t.var) =
    204208      <Bind-Var s.type t.var> :: s.i,
    205209      {
    206210        s.type : Result =
    207           <MVvisitTypeInsn s.mv &NEW "org/refal/plus/Expr">,
    208           <MVvisitInsn s.mv &DUP>,
    209           <MVvisitMethodInsn s.mv &INVOKESPECIAL "org/refal/plus/Result" "<init>" "()V">,
    210           <MVvisitVarInsn s.mv &ASTORE s.i>;
    211         <MVvisitFieldInsn s.mv &GETSTATIC "org/refal/plus/Expr" "empty" "Lorg/refal/plus/Expr;">,
    212           <MVvisitVarInsn s.mv &ASTORE s.i>;
     211          <MVvisitTypeInsn <MV> &NEW "org/refal/plus/Expr">,
     212          <MVvisitInsn <MV> &DUP>,
     213          <MVvisitMethodInsn <MV> &INVOKESPECIAL "org/refal/plus/Result" "<init>" "()V">,
     214          <MVvisitVarInsn <MV> &ASTORE s.i>;
     215        <MVvisitFieldInsn <MV> &GETSTATIC "org/refal/plus/Expr" "empty" "Lorg/refal/plus/Expr;">,
     216          <MVvisitVarInsn <MV> &ASTORE s.i>;
    213217      };
    214     RETFAIL = <MVvisitInsn s.mv &"ICONST_0"> <MVvisitInsn s.mv &IRETURN>;
     218    RETFAIL = <MVvisitInsn <MV> &"ICONST_0"> <MVvisitInsn <MV> &IRETURN>;
    215219    (IF (e.cond) e.body) =
    216220      <Box> :: s.acc,
     
    225229      ('{' (
    226230        e.if-yes-assigns
    227         <ASAIL-To-JBC e.body>
     231        <ASAIL-To-JBC-Temp e.body>
    228232      )'}' )
    229233      e.if-not-assigns : e;
     
    238242      } :: s.break-label,
    239243      <Label> :: s.for-label,
    240       <MVvisitLabel s.mv s.for-label>,
     244      <MVvisitLabel <MV> s.for-label>,
    241245      //<Cond-To-JBC s.acc e.cond> : e,
    242       <MVvisitJumpInsn s.mv &IFEQ s.break-label>,
    243       //<ASAIL-To-JBC e.body> : e,
    244       <MVvisitLabel s.mv s.cont-label>,
     246      <MVvisitJumpInsn <MV> &IFEQ s.break-label>,
     247      <ASAIL-To-JBC e.body>,
     248      <MVvisitLabel <MV> s.cont-label>,
    245249      //<Step-To-JBC e.step> : e,
    246       <MVvisitJumpInsn s.mv &GOTO s.for-label>,
    247       <MVvisitLabel s.mv s.break-label>;
     250      <MVvisitJumpInsn <MV> &GOTO s.for-label>,
     251      <MVvisitLabel <MV> s.break-label>;
    248252    (LABEL (t.label) e.body) =
    249253      <Bind-Label t.label> :: s.l,
    250       <Func-To-JBC s.mv e.body>,
    251       <MVvisitLabel s.mv s.l>;
     254      <ASAIL-To-JBC e.body>,
     255      <MVvisitLabel <MV> s.l>;
    252256    (s.tag t.label), s.tag : \{ CONTINUE; BREAK; } =
    253       <MVvisitJumpInsn s.mv &GOTO <Lookup-Label t.label>>;
     257      <MVvisitJumpInsn <MV> &GOTO <Lookup-Label t.label>>;
    254258    (TRY e.body) =
    255259      ('try') ('{' (
     
    258262            '"This is for avoiding \'Unreachable code\' errors");'
    259263        )   )
    260         <ASAIL-To-JBC e.body>
     264        <ASAIL-To-JBC-Temp e.body>
    261265      ) '}') : e;
    262266    (CATCH-ERROR e.body) =
    263267      ('catch (RefalException error) {' (
    264268        ('Expr err = error.getExpr ();')
    265         (<ASAIL-To-JBC e.body>)
     269        (<ASAIL-To-JBC-Temp e.body>)
    266270      ) '}') : e;
    267271    FATAL =
    268272      ('throw new RefalException ("'<? &Module-Name>'", "'<? &Func-Name>'", "Unexpected fail");') : e;
    269273    (LSPLIT t.name (e.min) t.var1 t.var2) =
    270       <Expr-Ref-To-JBC t.name> :: e.a (e.n),
     274      <Expr-Ref-To-JBC t.name>;/* :: e.a (e.n),
    271275      '_va_' <Free-Index> :: e.new-var,
    272276      <Bind &Iter-Vars (t.name) (e.new-var t.var1 t.var2)>,
     
    274278      <Expr-Int-To-JBC s.acc e.min> :: e.min,
    275279      e.a <? s.acc>
    276       ('Expr.SplitIterator 'e.new-var' = 'e.n'.leftSplit('e.min');') : e;
     280      ('Expr.SplitIterator 'e.new-var' = 'e.n'.leftSplit('e.min');') : e;*/
    277281    (RSPLIT t.name (e.min) t.var1 t.var2) =
    278       <Expr-Ref-To-JBC t.name> :: e.a (e.n),
     282      <Expr-Ref-To-JBC t.name>;/* :: e.a (e.n),
    279283      '_va_' <Free-Index> :: e.new-var,
    280284      <Bind &Iter-Vars (t.name) (e.new-var t.var1 t.var2)>,
     
    282286      <Expr-Int-To-JBC s.acc e.min> :: e.min,
    283287      e.a <? s.acc>
    284       ('Expr.SplitIterator 'e.new-var' = 'e.n'.rightSplit('e.min');') : e;
     288      ('Expr.SplitIterator 'e.new-var' = 'e.n'.rightSplit('e.min');') : e;*/
    285289    (ASSIGN t.var e.expr) =
    286       <Expr-To-JBC () e.expr> :: e.a (e.j-expr),
     290      <Expr-Ref-To-JBC e.expr>; /*:: e.a (e.j-expr),
    287291      {
    288292        <? &Ress> : e t.var e =
     
    290294        e.a (<Lookup &Result t.var>'.assign ('e.j-expr');');
    291295        e.a (<Rfp2Java t.var>' = 'e.j-expr';');
    292       } : e;
     296      } : e;*/
    293297    (INT t.var e.expr) =
    294       <Box> :: s.acc,
    295       <Expr-Int-To-JBC s.acc e.expr> :: e.expr,
    296       <? s.acc> ('int '<Rfp2Java t.var>' = 'e.expr';') : e;
     298      <Expr-Int-To-JBC e.expr>;/* :: e.expr,
     299      <? s.acc> ('int '<Rfp2Java t.var>' = 'e.expr';') : e;*/
    297300    (EXPR t.var e.expr) =
    298       <Unbind &Result t.var>,
    299       <Expr-Ref-To-JBC e.expr> :: e.a (e.j-expr),
    300       e.a ('Expr '<Rfp2Java t.var>' = 'e.j-expr';') : e;
     301      <Expr-Ref-To-JBC e.expr>; /* :: e.a (e.j-expr),
     302      e.a ('Expr '<Rfp2Java t.var>' = 'e.j-expr';') : e;*/
    301303    (DEREF t.var e.expr (e.pos)) =
    302       <Unbind &Result t.var>,
    303       <Expr-Ref-To-JBC e.expr> :: e.a (e.j-expr),
     304      <Expr-Ref-To-JBC e.expr>; /* :: e.a (e.j-expr),
    304305      <Box> :: s.acc,
    305306      <Expr-Int-To-JBC s.acc e.pos> :: e.pos,
    306       e.a <? s.acc> ('Expr '<Rfp2Java t.var>' = (Expr) 'e.j-expr'.at ('e.pos');') : e;
     307      e.a <? s.acc> ('Expr '<Rfp2Java t.var>' = (Expr) 'e.j-expr'.at ('e.pos');') : e;*/
    307308    (SUBEXPR t.var e.expr (e.pos) (e.len)) =
    308       <Unbind &Result t.var>,
    309       <Expr-Ref-To-JBC e.expr> :: e.a (e.j-expr),
    310       <Box> :: s.acc,
    311       <Expr-Int-To-JBC s.acc e.pos> :: e.pos,
    312       <Expr-Int-To-JBC s.acc e.len> :: e.len,
    313       e.a <? s.acc> ('Expr '<Rfp2Java t.var>' = new Expr ('e.j-expr', 'e.pos', 'e.len');') : e;
     309      <Expr-Ref-To-JBC e.expr>,
     310      <Expr-Int-To-JBC e.pos>,
     311      <Expr-Int-To-JBC e.len>;
     312      //e.a <? s.acc> ('Expr '<Rfp2Java t.var>' = new Expr ('e.j-expr', 'e.pos', 'e.len');') : e;
    314313    (DROP t.var) =
    315314      (<Var-To-JBC t.var>'.drop ();') : e;
    316315    (ERROR e.expr) =
    317       <Expr-Ref-To-JBC e.expr> :: e.a (e.j-expr),
    318       e.a ('throw new RefalException ('e.j-expr');') : e;
     316      <Expr-Ref-To-JBC e.expr>;
     317      //('throw new RefalException ('e.j-expr');') : e;
    319318    /*
    320319     * s.call can be CALL or TAILCALL or TAILCALL?
     
    330329          <Store &Res-Assigns /*empty*/>;
    331330      } : e;
    332   },
    333     $fail;;
    334 };
    335 
    336 ASAIL-To-JBC e = ;
     331  }, $fail; e;
     332};
     333
     334ASAIL-To-JBC-Temp e = ;
    337335
    338336Declare-Results {
     
    347345};
    348346
    349 /*
    350  * Determine type of e.expr - int or Refal.
    351  */
    352 Expr-To-JBC (e.init) e.expr-all, e.expr-all : {
    353   /*empty*/ = <Expr-Ref-To-JBC e.init>;
    354   (PAREN e.expr) e.rest = <Expr-Ref-To-JBC e.init e.expr-all>;
    355   (EXPR e.expr) e.rest = <Expr-Ref-To-JBC e.init e.expr-all>;
    356   (DEREF e.expr) e.rest = <Expr-Ref-To-JBC e.init e.expr-all>;
    357   (SUBEXPR e.expr) e.rest = <Expr-Ref-To-JBC e.init e.expr-all>;
    358   (LENGTH e.expr) e.rest = (<Expr-Int-To-JBC XXX e.init e.expr-all>);
    359   (MAX e.args) e.rest = (<Expr-Int-To-JBC XXX e.init e.expr-all>);
    360   (MIN e.args) e.rest = (<Expr-Int-To-JBC XXX e.init e.expr-all>);
    361   (INFIX s.op e.args) e.rest = (<Expr-Int-To-JBC XXX e.init e.expr-all>);
    362   (s.var-tag (e.QualifiedName)) e.rest =
    363     <Expr-To-JBC (e.init (s.var-tag (e.QualifiedName))) e.rest>;
    364 };
    365 
    366 $func Term-Ref-To-JBC s.acc term = e.term;
     347$func Term-Ref-To-JBC t.term = ;
    367348
    368349Expr-Ref-To-JBC {
    369   /*empty*/ = ('Expr.empty');
    370   term =
    371     <Box> :: s.acc,
    372     <Term-Ref-To-JBC s.acc term> :: e.term,
    373     <? s.acc> (e.term);
    374   t1 t2 =
    375     <Box> :: s.acc,
    376     <Term-Ref-To-JBC s.acc t1> :: e.t1,
    377     <Term-Ref-To-JBC s.acc t2> :: e.t2,
    378     <? s.acc> ('new Expr ('e.t1', 'e.t2')');
    379   expr =
    380     '_va_'<Free-Index> :: e.new-var,
    381     <Box> :: s.acc,
    382     <Infix-To-JBC s.acc &Term-Ref-To-JBC "," <Paren expr>> :: e.arr-init,
    383     <? s.acc>
    384     ('Expr[] 'e.new-var' = { 'e.arr-init' };')
    385     ('Expr.concat ('e.new-var')');
    386 };
    387 
    388 Term-Ref-To-JBC s.acc term = term : {
     350  /*empty*/ = <MVvisitFieldInsn <MV> &GETSTATIC "org/refal/plus/Expr" "empty" "Lorg/refal/plus/Expr;">;
     351  t.term = <Term-Ref-To-JBC t.term>;
     352  t.term1 t.term2 =
     353    <MVvisitTypeInsn <MV> &NEW "org/refal/plus/Expr">,
     354    <MVvisitInsn <MV> &DUP>,
     355    <Term-Ref-To-JBC t.term1>,
     356    <Term-Ref-To-JBC t.term2>,
     357    <MVvisitMethodInsn <MV> &INVOKESPECIAL "org/refal/plus/Expr" "<init>" "(Lorg/refal/plus/Expr;Lorg/refal/plus/Expr;)V">;
     358  e.expr =
     359    <MVvisitLdcInsn <MV> <Integer <Length e.expr>>>,
     360    <MVvisitTypeInsn <MV> &ANEWARRAY "org/refal/plus/Expr">,
     361    0 e.expr $iter {
     362      e.expr : t.term e.rest,
     363        <MVvisitInsn <MV> &DUP>,
     364        <MVvisitLdcInsn <MV> <Integer s.i>>,
     365        <Term-Ref-To-JBC t.term>,
     366        <MVvisitInsn <MV> &AASTORE>,
     367        <"+" s.i 1> e.rest;
     368    } :: s.i e.expr,
     369    e.expr : /*empty*/ =
     370    <MVvisitMethodInsn <MV> &INVOKESTATIC "org/refal/plus/Expr" "concat" "([Lorg/refal/plus/Expr;)Lorg/refal/plus/Expr;">;
     371};
     372
     373Term-Ref-To-JBC {
    389374  (PAREN e.expr) =
    390     <Expr-Ref-To-JBC e.expr> :: e.a (e.j-expr),
    391     <Put s.acc e.a>,
    392     'new Expr('e.j-expr')';
     375    <MVvisitTypeInsn <MV> &NEW "org/refal/plus/Expr">,
     376    <MVvisitInsn <MV> &DUP>,
     377    <Expr-Ref-To-JBC e.expr>,
     378    <MVvisitMethodInsn <MV> &INVOKESPECIAL "org/refal/plus/Expr" "<init>" "(Lorg/refal/plus/Expr;)V">;
    393379  (DEREF e.expr (e.pos)) =
    394     <Expr-Ref-To-JBC e.expr> :: e.a (e.j-expr),
    395     <Put s.acc e.a>,
    396     <Expr-Int-To-JBC s.acc e.pos> :: e.pos,
    397     '(Expr) 'e.j-expr'.at ('e.pos')';
     380    <Expr-Ref-To-JBC e.expr>,
     381    <Expr-Int-To-JBC e.pos>,
     382    <MVvisitMethodInsn <MV> &INVOKEVIRTUAL "org/refal/plus/Expr" "at" "(I)Ljava/lang/Object;">,
     383    <MVvisitTypeInsn <MV> &CHECKCAST "org/refal/plus/Expr">;
    398384  (SUBEXPR e.expr (e.pos) (e.len)) =
    399     <Expr-Ref-To-JBC e.expr> :: e.a (e.j-expr),
    400     <Put s.acc e.a>,
    401     <Expr-Int-To-JBC s.acc e.pos> :: e.pos,
    402     <Expr-Int-To-JBC s.acc e.len> :: e.len,
    403     'new Expr ('e.j-expr', 'e.pos', 'e.len')';
    404   (REF t.name) = <Name-To-JBC t.name>;
    405   ERROR-EXPR = 'err';
    406   (s.var-tag e.ns t.name) = <Var-To-JBC term>;
    407 };
    408 
    409 Expr-Int-To-JBC s.acc expr = expr : {
    410 //  /*empty*/ = /*empty*/;
     385    <MVvisitTypeInsn <MV> &NEW "org/refal/plus/Expr">,
     386    <MVvisitInsn <MV> &DUP>,
     387    <Expr-Ref-To-JBC e.expr>,
     388    <Expr-Int-To-JBC e.pos>,
     389    <Expr-Int-To-JBC e.len>,
     390    <MVvisitMethodInsn <MV> &INVOKESPECIAL "org/refal/plus/Expr" "<init>" "(Lorg/refal/plus/Expr;II)V">;
     391  (REF t.name) = <Name-To-JBC t.name> :e;
     392  //ERROR-EXPR = 'err';
     393  t.term, t.term : (s.var-tag e) = <Var-To-JBC t.term>;
     394};
     395
     396Expr-Int-To-JBC {
    411397  s.ObjectSymbol =
    412398    {
    413       <Int? s.ObjectSymbol> = s.ObjectSymbol;
     399      <Int? s.ObjectSymbol> =
     400        <MVvisitLdcInsn <MV> <Integer s.ObjectSymbol>>;
    414401      $error ("Illegal int-symbol: " s.ObjectSymbol);
    415402        //FIXME: надо проверять, что число не
     
    417404        //       Задавать эти границы опциями.
    418405    };
    419   (LENGTH e.expr) =
    420     <Expr-Ref-To-JBC e.expr> :: e.a (e.j-expr),
    421     <Put s.acc e.a>,
    422     e.j-expr'.getLen ()';
    423   (MAX e.args) =
    424     'java.lang.Math.max ('<Int-Args-To-JBC s.acc e.args>')';
    425   (MIN e.args) =
    426     'java.lang.Math.min ('<Int-Args-To-JBC s.acc e.args>')';
     406  (LENGTH e.x) =
     407    <Expr-Ref-To-JBC e.x>,
     408    <MVvisitMethodInsn <MV> &INVOKEVIRTUAL "org/refal/plus/Expr" "getLen" "()I">;
     409  (s.tag (e.x) (e.y)),
     410    s.tag : \{ MIN = "min"; MAX = "max"; } :: s.fn =
     411    <Expr-Int-To-JBC e.x>,
     412    <Expr-Int-To-JBC e.y>,
     413    <MVvisitMethodInsn <MV> &INVOKESTATIC "java/lang/Math" s.fn "(II)I">;
    427414  (INFIX s.op e.args) =
    428     '(' <Infix-To-JBC s.acc &Expr-Int-To-JBC s.op e.args> ')';
    429 //  (REF t.name) = <Name-To-JBC t.name>;
    430   (s.var-tag t.name) = <Rfp2Java (s.var-tag t.name)>;
    431   expr = '(' <Infix-To-JBC s.acc &Expr-Int-To-JBC "+" <Paren expr>> ')';
     415    <Infix-To-JBC &Expr-Int-To-JBC s.op e.args>;
     416  t.term, t.term : (s.var-tag e) = <Var-To-JBC t.term>;
     417  e.expr = <Infix-To-JBC &Expr-Int-To-JBC "+" <Paren e.expr>>;
    432418};
    433419
     
    440426    <Name-To-JBC t.name>' ('e.args')';
    441427  (SYMBOL? e.expr (e.pos)) =
    442     <Expr-Ref-To-JBC e.expr> :: e.a (e.j-expr),
     428    <Expr-Ref-To-JBC e.expr>;/* :: e.a (e.j-expr),
    443429    <Put s.acc e.a>,
    444     e.j-expr'.symbolAt ('<Expr-Int-To-JBC s.acc e.pos>')';
    445   (CHECK-ITER e.expr) =
    446     <Middle 0 2 <Lookup &Iter-Vars e.expr>>'.isValid ()';
     430    e.j-expr'.symbolAt ('<Expr-Int-To-JBC s.acc e.pos>')';*/
     431  (CHECK-ITER e.expr) = ;
     432    //<Middle 0 2 <Lookup &Iter-Vars e.expr>>'.isValid ()';
    447433  (EQ e.expr1 (e.expr2) (e.pos)) =
    448     <Expr-Ref-To-JBC e.expr1> :: e.a1 (e.j-expr1),
    449     <Expr-Ref-To-JBC e.expr2> :: e.a2 (e.j-expr2),
     434    <Expr-Ref-To-JBC e.expr1>,// :: e.a1 (e.j-expr1),
     435    <Expr-Ref-To-JBC e.expr2>;/* :: e.a2 (e.j-expr2),
    450436    <Put s.acc e.a1 e.a2>,
    451     e.j-expr1'.eq ('e.j-expr2', '<Expr-Int-To-JBC s.acc e.pos>')';
     437    e.j-expr1'.eq ('e.j-expr2', '<Expr-Int-To-JBC s.acc e.pos>')'; */
    452438  (TERM-EQ e.expr1 (e.expr2) (e.pos)) =
    453     <Expr-Ref-To-JBC e.expr1> :: e.a1 (e.j-expr1),
    454     <Expr-Ref-To-JBC e.expr2> :: e.a2 (e.j-expr2),
     439    <Expr-Ref-To-JBC e.expr1>,// :: e.a1 (e.j-expr1),
     440    <Expr-Ref-To-JBC e.expr2>;/* :: e.a2 (e.j-expr2),
    455441    <Put s.acc e.a1 e.a2>,
    456     e.j-expr1'.eq ('e.j-expr2', '<Expr-Int-To-JBC s.acc e.pos> ')';
     442    e.j-expr1'.eq ('e.j-expr2', '<Expr-Int-To-JBC s.acc e.pos> ')'; */
    457443  (NOT e.cond) =
    458     '!' <Cond-To-JBC s.acc e.cond>;
     444    '!' <Cond-To-JBC s.acc e.cond> : e;
    459445  (INFIX s.op e.args) =
    460446    {
    461       s.op : \{ "+"; "-"; "%"; "*"; "/"; } =
    462         <Infix-To-JBC s.acc &Expr-Int-To-JBC s.op e.args>' != 0';
    463       '(' <Infix-To-JBC s.acc <Op-Arg-To-JBC s.op> s.op e.args> ')';
     447      s.op : \{ "+"; "-"; "%"; "*"; "/"; },
     448        <Infix-To-JBC &Expr-Int-To-JBC s.op e.args>' != 0' : e;
     449      s.op : \{ "&&"; "||"; },
     450        <Infix-To-JBC &Cond-To-JBC s.op e.args>;
     451      s.op : \{ "<"; ">"; "<="; ">="; "=="; "!="; },
     452        <Infix-To-JBC &Expr-Int-To-JBC s.op e.args>;
    464453    };
    465454  expr = '(' <Infix-To-JBC s.acc &Cond-To-JBC "&&" <Paren expr>> ')';
    466455};
    467456
    468 Infix-To-JBC s.acc s.arg2java s.op e.args, {
    469   e.args : (e.arg) e.rest =
    470     <Apply s.arg2java s.acc e.arg> :: e.arg,
    471     <Infix-To-JBC s.acc s.arg2java s.op e.rest> :: e.rest,
    472     {
    473       e.arg : v, e.rest : v = e.arg ' ' s.op ' ' e.rest;
    474       e.arg e.rest;
    475     };;
    476 };
    477 
    478 Op-Arg-To-JBC s.op, {
    479   s.op : \{ "&&"; "||"; } =
    480     &Cond-To-JBC;
    481   s.op : \{ "<"; ">"; "<="; ">="; "=="; "!="; "+"; "-"; "%"; "*"; "/"; } =
    482     &Expr-Int-To-JBC;
    483 };
    484  
     457Infix-To-JBC s.arg2java s.op (e.arg) e.args =
     458  s.op : \{
     459    "+" = &IADD;
     460    "-" = &ISUB;
     461    "%" = &IREM;
     462    "*" = &IMUL;
     463    "/" = &IDIV;
     464    s = &IAND;
     465  } :: s.jbcop,
     466  <Apply s.arg2java e.arg> : e,
     467  {
     468    e.args : e (e.arg2) e,
     469      <Apply s.arg2java e.arg2> : e,
     470      <MVvisitInsn <MV> s.jbcop>,
     471      $fail;;
     472  };
     473
    485474Step-To-JBC {
    486475  /*empty*/ = /*empty*/;
     
    580569  e.java-args;
    581570
    582 Var-Args-To-JBC e.args =
    583   e.args (/*e.type*/) (/*e.java-args*/) $iter {
    584     e.args : s.t e.rest =
    585       e.rest (s.t) (e.java-args);
    586     e.args : t.arg e.rest =
    587       {
    588         e.rest : e (e) e = ', ';
    589         /*empty*/;
    590       } :: e.comma,
    591       e.rest (e.type) (e.java-args e.type' '<Rfp2Java t.arg> e.comma);
    592     } :: e.args (e.type) (e.java-args),
    593   e.args : /*empty*/ =
    594   e.java-args;
    595 
    596571Expr-Args-To-JBC e.args =
    597572  e.args (/*e.type*/) (/*e.java-args*/) (/*e.arrays*/) $iter {
     
    604579      } :: e.comma,
    605580      {
    606         e.type : /*empty*/ =
     581        /*e.type : empty =
    607582          <Expr-Ref-To-JBC e.arg> :: e.a (e.j-arg),
    608           e.rest (e.type) (e.java-args e.j-arg e.comma) (e.arrays e.a);
     583          e.rest (e.type) (e.java-args e.j-arg e.comma) (e.arrays e.a);*/
    609584        e.rest (e.type) (e.java-args e.arg e.comma) (e.arrays);
    610585      };
     
    622597  };
    623598
    624 Var-To-JBC t.var = {
    625   <Lookup &Result t.var>'.getExpr ()';
    626   <Rfp2Java t.var>;
    627 };
     599Var-To-JBC t.var =
     600  <Lookup-Var t.var> :: s.type s.i,
     601  <MVvisitVarInsn <MV> &ALOAD s.i>,
     602  {
     603    s.type : Result =
     604      <MVvisitMethodInsn <MV> &INVOKEVIRTUAL "org/refal/plus/Result" "getExpr" "()Lorg/refal/plus/Expr;">;;
     605  };
    628606
    629607Access-Mode t.name, {
  • to-imperative/trunk/compiler/rfp_compile.rf

    r2068 r2347  
    12051205    <Create-Int-Var ("len") Aux e.minuend> :: t.m-var e.m-assign,
    12061206      <Create-Int-Var ("len") Aux e.subtrahend> :: t.s-var e.s-assign,
    1207       ((INFIX "<" (t.m-var)
     1207      (IF ((INFIX "<" (t.m-var)
    12081208        ((INFIX "+" (t.s-var)
    12091209              ((INFIX "*" (e.min) (s.mult)))
    1210         ))                      )) :: e.min-cond,
     1210        ))                      ) e.end-cycle)) :: e.min-cond,
    12111211      <Get-Var Max t.var> : {
    12121212        /*empty*/;
    12131213        e.max =
    1214           ((INFIX ">" (t.m-var)
     1214          (IF ((INFIX ">" (t.m-var)
    12151215            ((INFIX "+" (t.s-var)
    12161216                  ((INFIX "*" (e.max) (s.mult)))
    1217           ))                    ));
     1217          ))                    ) e.end-cycle));
    12181218      } :: e.max-cond,
    12191219      (INFIX "%" ((INFIX "-" (t.m-var) (t.s-var))) (s.mult)) :: e.div-cond,
     
    12271227      <Map &Reclassify-Clash (<Sub (e.clashes) <? &Checked-Lengths>>)> : e,
    12281228      e.m-assign e.s-assign
    1229       (IF ((INFIX "||" e.min-cond e.max-cond)) e.end-cycle)
     1229      e.min-cond e.max-cond
    12301230      (IF (e.div-cond) e.fail)
    12311231      e.len-assign;
     
    12421242      <Get-Max e.vars-Re> :: e.max =
    12431243        <Get-Min e.vars-Pe> :: e.min,
    1244         ((INFIX "<" (e.len-Re e.max) (e.len-Pe e.min)));
     1244        (IF ((INFIX "<" (e.len-Re e.max) (e.len-Pe e.min))) e.fail);
    12451245      /*empty*/;
    12461246    } :: e.cond1,
     
    12481248      <Get-Max e.vars-Pe> :: e.max =
    12491249        <Get-Min e.vars-Re> :: e.min,
    1250         ((INFIX ">" (e.len-Re e.min) (e.len-Pe e.max)));
     1250        (IF ((INFIX ">" (e.len-Re e.min) (e.len-Pe e.max))) e.fail);
    12511251      /*empty*/;
    12521252    } :: e.cond2,
    1253     {
    1254       e.cond1 : /*empty*/, e.cond2 : /*empty*/ = /*empty*/;
    1255       (IF ((INFIX "||" e.cond1 e.cond2)) e.fail);
    1256     } :: e.cond,
    1257     e.cond
     1253    e.cond1 e.cond2
    12581254    <CC-Unknown-Lengths (e.fail) e.rest>;
    12591255  <RFP-Clear-Table &Unknown-Lengths>;
Note: See TracChangeset for help on using the changeset viewer.