Add support for IfThen() instrinsic that works like the if-statement in that it evaluates only the expression that is indeed executed.

The result type of the intrinsic is determined by the Then-expression to provide a bit of control. There might however be some situations in which this fails, for this exceptions need to be added (e.g. a constant string needs to be converted to a normal string).

compinnr.inc:
  + add new constant in_ifthen_x_y_z for the IfThen() intrinsic
psystem.pas: 
  + create_intern_symbols: add symbol for IfThen() intrinsic
pexpr.pas:
  * statement_syssym: parse parameters of IfThen() intrinsic and return corresponding inline node
ninl.pas, tinlinenode:
  + new method handle_ifthen() which converts the inline node to an if-node which assigns the expressions to a temp node that is returned
  * pass_typecheck: handle in_ifthen_x_y_z using handle_ifthen()
  * pass_1: in_ifthen_x_y_z does not need a first pass as it's already converted after the typecheck pass

+ added tests

git-svn-id: trunk@33036 -

.gitattributes

@@ -12337,6 +12337,8 @@ tests/test/thlp6.pp svneol=native#text/pascal
 tests/test/thlp7.pp svneol=native#text/pascal
 tests/test/thlp8.pp svneol=native#text/pascal
 tests/test/thlp9.pp svneol=native#text/pascal
+tests/test/tifthen1.pp svneol=native#text/pascal
+tests/test/tifthen2.pp svneol=native#text/pascal
 tests/test/timplements1.pp svneol=native#text/plain
 tests/test/timplements2.pp svneol=native#text/plain
 tests/test/timplements3.pp svneol=native#text/plain

compiler/compinnr.inc

@@ -89,6 +89,7 @@ const
    in_popcnt_x          = 79;
    in_aligned_x         = 80;
    in_setstring_x_y_z   = 81;
+   in_ifthen_x_y_z      = 82;
 
 { Internal constant functions }
    in_const_sqr        = 100;

compiler/ninl.pas

@@ -99,6 +99,7 @@ interface
           function handle_copy: tnode;
           function handle_box: tnode;
           function handle_unbox: tnode;
+          function handle_ifthen: tnode;
        end;
        tinlinenodeclass = class of tinlinenode;
 
@@ -3281,6 +3282,10 @@ implementation
                   set_varstate(tcallparanode(tcallparanode(tcallparanode(left).right).right).left,vs_read,[vsf_must_be_valid]);
                   resultdef:=tcallparanode(left).left.resultdef;
                 end;
+              in_ifthen_x_y_z:
+                begin
+                  result:=handle_ifthen;
+                end;
               else
                 internalerror(8);
             end;
@@ -3631,6 +3636,8 @@ implementation
          in_fma_extended,
          in_fma_float128:
            result:=first_fma;
+         in_ifthen_x_y_z:
+           internalerror(2016013105);
          else
            internalerror(89);
           end;
@@ -4245,6 +4252,77 @@ implementation
        end;
 
 
+     function tinlinenode.handle_ifthen: tnode;
+       var
+         stat : tstatementnode;
+         tempnode : ttempcreatenode;
+         n,
+         condexpr,
+         thenexpr,
+         elseexpr : tnode;
+         resdef : tdef;
+       begin
+         if left.nodetype<>callparan then
+           internalerror(2016013101);
+         condexpr:=tcallparanode(left).left;
+         tcallparanode(left).left:=nil;
+         n:=tcallparanode(left).right;
+         if n.nodetype<>callparan then
+           internalerror(2016013102);
+         thenexpr:=tcallparanode(n).left;
+         tcallparanode(n).left:=nil;
+         n:=tcallparanode(n).right;
+         if n.nodetype<>callparan then
+           internalerror(2016013103);
+         elseexpr:=tcallparanode(n).left;
+         tcallparanode(n).left:=nil;
+         if assigned(tcallparanode(n).right) then
+           internalerror(2016013104);
+
+         { The result type of the expression is that of the then-expression; the
+           else-expression is converted to that if possible (otherwise error)
+           There are a few special cases however:
+           - constant strings need to be converted to strings
+           - chars need to be checked with strings
+         }
+
+         if is_conststringnode(thenexpr) then
+           begin
+             if is_constwidestringnode(elseexpr) or is_constwidecharnode(elseexpr) then
+               resdef:=cwidestringtype
+             else
+               resdef:=cansistringtype;
+           end
+         else if is_constcharnode(thenexpr) then
+           begin
+             if is_constcharnode(elseexpr) then
+               resdef:=cansichartype
+             else if is_constwidecharnode(elseexpr) then
+               resdef:=cwidechartype
+             else if is_string(elseexpr.resultdef) then
+               resdef:=elseexpr.resultdef
+             else
+               resdef:=thenexpr.resultdef;
+           end
+         else
+           resdef:=thenexpr.resultdef;
+
+         result:=internalstatements(stat);
+
+         { create the tempnode that will hold our result }
+         tempnode:=ctempcreatenode.create(resdef,resdef.size,tt_persistent,true);
+         addstatement(stat,tempnode);
+
+         n:=cifnode.create(condexpr,
+                            cassignmentnode.create(ctemprefnode.create(tempnode),thenexpr),
+                            cassignmentnode.create(ctemprefnode.create(tempnode),elseexpr)
+                          );
+         addstatement(stat,n);
+
+         addstatement(stat,ctempdeletenode.create_normal_temp(tempnode));
+         addstatement(stat,ctemprefnode.create(tempnode));
+       end;
+
      function tinlinenode.first_pack_unpack: tnode;
        var
          loopstatement    : tstatementnode;

compiler/pexpr.pas

@@ -914,6 +914,20 @@ implementation
             begin
               statement_syssym := inline_setstring;
             end;
+
+          in_ifthen_x_y_z:
+            begin
+              consume(_LKLAMMER);
+              in_args:=true;
+              p1:=comp_expr([ef_accept_equal]);
+              consume(_COMMA);
+              p2:=comp_expr([ef_accept_equal]);
+              consume(_COMMA);
+              paras:=comp_expr([ef_accept_equal]);
+              statement_syssym:=geninlinenode(l,false,ccallparanode.create(p1,ccallparanode.create(p2,ccallparanode.create(paras,nil))));
+              consume(_RKLAMMER);
+            end;
+
           else
             internalerror(15);
 

compiler/psystem.pas

@@ -105,6 +105,7 @@ implementation
         systemunit.insert(csyssym.create('ObjCEncode',in_objc_encode_x)); { objc only }
         systemunit.insert(csyssym.create('Default',in_default_x));
         systemunit.insert(csyssym.create('SetString',in_setstring_x_y_z));
+        systemunit.insert(csyssym.create('IfThen',in_ifthen_x_y_z));
         systemunit.insert(cconstsym.create_ord('False',constord,0,pasbool8type));
         systemunit.insert(cconstsym.create_ord('True',constord,1,pasbool8type));
       end;

tests/test/tifthen1.pp

@@ -0,0 +1,27 @@
+program tifthen1;
+
+procedure Test(aValue: Boolean; aErrOffset: LongInt);
+var
+  i: LongInt;
+  s: String;
+  b: Boolean;
+  c: Char;
+begin
+  i := IfThen(aValue, 42, 21);
+  if (aValue and (i <> 42)) or (not aValue and (i <> 21)) then
+    Halt(aErrOffset + 1);
+  b := IfThen(aValue, False, True);
+  if (aValue and b) or (not aValue and not b) then
+    Halt(aErrOffset + 2);
+  s := IfThen(aValue, 'Hello', 'World');
+  if (aValue and (s <> 'Hello')) or (not aValue and (s <> 'World')) then
+    Halt(aErrOffset + 3);
+  c := IfThen(aValue, #13, #10);
+  if (aValue and (c <> #13)) or (not aValue and (c <> #10)) then
+    Halt(aErrOffset + 4);
+end;
+
+begin
+  Test(False, 0);
+  Test(True, 40);
+end.

tests/test/tifthen2.pp

@@ -0,0 +1,33 @@
+program tifthen2;
+
+var
+  execA: Boolean = False;
+  execB: Boolean = False;
+
+function A: LongInt;
+begin
+  A := 42;
+  execA := True;
+end;
+
+function B: LongInt;
+begin
+  B := 21;
+  execB := True;
+end;
+
+procedure Test(aValue: Boolean; aErrOffset: LongInt);
+begin
+  execA := False;
+  execB := False;
+  IfThen(aValue, A, B);
+  if (aValue and not execA) or (not aValue and not execB) then
+    Halt(aErrOffset + 1);
+  if (aValue and execB) or (not aValue and execA) then
+    Halt(aErrOffset + 2);
+end;
+
+begin
+  Test(True, 0);
+  Test(False, 10);
+end.