浏览代码

+ add utility function arrayconstructor_can_be_set which uses similar code to arrayconstructor_to_set to check whether an array constructor has even a chance to be converted to a set

git-svn-id: trunk@36093 -
svenbarth 8 年之前
父节点
当前提交
cc5e3fdee9
共有 1 个文件被更改,包括 81 次插入0 次删除
  1. 81 0
      compiler/ncnv.pas

+ 81 - 0
compiler/ncnv.pas

@@ -287,6 +287,7 @@ interface
     procedure inserttypeconv_explicit(var p:tnode;def:tdef);
     procedure inserttypeconv_explicit(var p:tnode;def:tdef);
     procedure inserttypeconv_internal(var p:tnode;def:tdef);
     procedure inserttypeconv_internal(var p:tnode;def:tdef);
     procedure arrayconstructor_to_set(var p : tnode);
     procedure arrayconstructor_to_set(var p : tnode);
+    function arrayconstructor_can_be_set(p:tnode):boolean;
     procedure insert_varargstypeconv(var p : tnode; iscvarargs: boolean);
     procedure insert_varargstypeconv(var p : tnode; iscvarargs: boolean);
 
 
     function maybe_global_proc_to_nested(var fromnode: tnode; todef: tdef): boolean;
     function maybe_global_proc_to_nested(var fromnode: tnode; todef: tdef): boolean;
@@ -463,6 +464,7 @@ implementation
         hp : tarrayconstructornode;
         hp : tarrayconstructornode;
         oldfilepos: tfileposinfo;
         oldfilepos: tfileposinfo;
       begin
       begin
+        { keep in sync with arrayconstructor_can_be_set }
         if p.nodetype<>arrayconstructorn then
         if p.nodetype<>arrayconstructorn then
           internalerror(200205105);
           internalerror(200205105);
         new(constset);
         new(constset);
@@ -656,6 +658,85 @@ implementation
       end;
       end;
 
 
 
 
+    function arrayconstructor_can_be_set(p:tnode):boolean;
+      var
+        p1,p2 : tnode;
+        hdef : tdef;
+      begin
+        { keep in sync with arrayconstructor_to_set }
+        if not assigned(p) then
+          internalerror(2015050401);
+        if not assigned(tarrayconstructornode(p).left) then
+          begin
+            if assigned(tarrayconstructornode(p).right) then
+              internalerror(2015050103);
+            result:=true;
+          end
+        else
+          begin
+            result:=false;
+
+            hdef:=nil;
+
+            while assigned(p) do
+              begin
+                if tarrayconstructornode(p).left.nodetype=arrayconstructorrangen then
+                  begin
+                    p1:=tarrayconstructorrangenode(tarrayconstructornode(p).left).left;
+                    p2:=tarrayconstructorrangenode(tarrayconstructornode(p).left).right;
+                  end
+                else
+                  begin
+                    p1:=tarrayconstructornode(p).left;
+                    p2:=nil;
+                  end;
+
+                case p1.resultdef.typ of
+                  orddef,
+                  enumdef:
+                    begin
+                      if is_widechar(p1.resultdef) then
+                        begin
+                          if p1.nodetype<>ordconstn then
+                            exit
+                          else if tordconstnode(p1).value.uvalue>high(byte) then
+                            exit;
+                        end;
+
+                      if assigned(p2) then
+                        begin
+                          if is_widechar(p2.resultdef) then
+                            begin
+                              if p2.nodetype<>ordconstn then
+                                exit
+                              else if tordconstnode(p2).value.uvalue>high(byte) then
+                                exit;
+                            end;
+
+                          { anything to exclude? }
+                        end
+                      else
+                        begin
+                          { anything to exclude? }
+                        end;
+                    end;
+                  stringdef:
+                    if p1.nodetype<>stringconstn then
+                      exit
+                    else if assigned(hdef) and not is_char(hdef) then
+                      exit;
+                  else
+                    exit;
+                end;
+
+                p:=tarrayconstructornode(p).right;
+              end;
+
+            result:=true;
+          end;
+      end;
+
+
     procedure insert_varargstypeconv(var p : tnode; iscvarargs: boolean);
     procedure insert_varargstypeconv(var p : tnode; iscvarargs: boolean);
       begin
       begin
         { procvars without arguments in variant arrays are always called by
         { procvars without arguments in variant arrays are always called by