Merge branch 'devel'

Author: fibodevy

compiler/defcmp.pas

@@ -192,10 +192,13 @@ interface
     { procdefs the parameters defs shall belong to.                       }
     function equal_genfunc_paradefs(fwdef,currdef:tdef;fwpdst,currpdst:tsymtable):boolean;
 
+    function tuples_have_equal_shape(a,b:trecorddef):boolean;
+
 
 implementation
 
     uses
+      cutils,
       verbose,systems,constexp,
       symtable,symsym,symcpu,
       defutil,symutil;
@@ -213,6 +216,60 @@ implementation
       end;
 
 
+    { true if a tuple record uses auto-generated _1, _2, _3 ... field names }
+    function is_positional_tuple(t:trecorddef):boolean;
+      var
+        i,idx : longint;
+        sym : tsym;
+      begin
+        result:=false;
+        idx:=0;
+        for i:=0 to t.symtable.symlist.count-1 do
+          begin
+            sym:=tsym(t.symtable.symlist[i]);
+            if sym.typ<>fieldvarsym then
+              continue;
+            inc(idx);
+            if sym.name<>'_'+tostr(idx) then
+              exit;
+          end;
+        result:=idx>0;
+      end;
+
+
+    { two tuple records are shape-equal if the fields line up by index
+      with equal types. Field names must also match, UNLESS one side is
+      positional (auto _1, _2 ...), in which case names on the other
+      side are ignored. }
+    function tuples_have_equal_shape(a,b:trecorddef):boolean;
+      var
+        lista,listb : tfphashobjectlist;
+        i : longint;
+        fa,fb : tfieldvarsym;
+        ignore_names : boolean;
+      begin
+        result:=false;
+        lista:=a.symtable.symlist;
+        listb:=b.symtable.symlist;
+        if lista.count<>listb.count then
+          exit;
+        ignore_names:=is_positional_tuple(a) or is_positional_tuple(b);
+        for i:=0 to lista.count-1 do
+          begin
+            if (tsym(lista[i]).typ<>fieldvarsym) or
+               (tsym(listb[i]).typ<>fieldvarsym) then
+              exit;
+            fa:=tfieldvarsym(lista[i]);
+            fb:=tfieldvarsym(listb[i]);
+            if (not ignore_names) and (fa.name<>fb.name) then
+              exit;
+            if not equal_defs(fa.vardef,fb.vardef) then
+              exit;
+          end;
+        result:=true;
+      end;
+
+
     function compare_defs_ext(def_from,def_to : tdef;
                               fromtreetype : tnodetype;
                               var doconv : tconverttype;
@@ -307,6 +364,20 @@ implementation
             exit;
           end;
 
+         { two records where at least one is a tuple: structural compat
+           when shapes match (field count, names, types in order).
+           Positional tuples ignore names on either side. }
+         if (def_from.typ=recorddef) and
+            (def_to.typ=recorddef) and
+            ((df_tuple in def_from.defoptions) or
+             (df_tuple in def_to.defoptions)) and
+            tuples_have_equal_shape(trecorddef(def_from),trecorddef(def_to)) then
+          begin
+            doconv:=tc_equal;
+            compare_defs_ext:=te_equal;
+            exit;
+          end;
+
          if cdo_strict_undefined_check in cdoptions then
            begin
              { two different undefined defs are not considered equal }

compiler/globals.pas

@@ -68,7 +68,7 @@ interface
           m_property,m_default_inline,m_except,m_multiline_strings];
        unleashedmodeswitches = objfpcmodeswitches+[m_default_ansistring,m_underscoreisseparator,m_duplicate_names,
         m_advanced_records,m_array_operators,m_anonymous_functions,m_function_references,
-        m_statement_expressions,m_array_equality,m_inline_var,m_multiline_strings,
+        m_statement_expressions,m_array_equality,m_inline_var,m_tuples,m_match,m_multiline_strings,
         m_multi_var_init,m_unleashed];
        tpmodeswitches =
          [m_tp7,m_tp_procvar,m_duplicate_names];

compiler/globtype.pas

@@ -562,7 +562,9 @@        ttargetswitchinfo = record
          m_array_equality,      { enables equality operator in addition to ArrayOperators modeswitch }
          m_no_rtti,             { hides RTTI ASCII text }
          m_inline_var,          { allow inline variable declarations inside statement blocks }
-         m_multi_var_init       { allow initializing multiple variables in one declaration }
+         m_multi_var_init,      { allow initializing multiple variables in one declaration }
+         m_tuples,              { allow anonymous tuple types as function return types and related literals }
+         m_match                { match statement with first-match and fallthrough modes }
        );
        tmodeswitches = set of tmodeswitch;
 
@@ -775,7 +777,9 @@        ttargetswitchinfo = record
          'ARRAYEQUALITY',
          'NORTTI',
          'INLINEVARS',
-         'MULTIVARINIT'
+         'MULTIVARINIT',
+         'TUPLES',
+         'MATCH'
          );
 
 

compiler/msg/errore.msg

@@ -498,7 +498,7 @@ scan_e_improperly_indented_multiline_string=02120_E_Incorrectly indented multi-l
 #
 # Parser
 #
-# 03376 is the last used one
+# 03377 is the last used one
 #
 % \section{Parser messages}
 % This section lists all parser messages. The parser takes care of the
@@ -1728,11 +1728,13 @@ parser_w_with_shadowed_field=03376_W_Field "$1" in WITH entry shadows an earlier
 % Two entries in the same \var{with} clause expose a field with the same name.
 % The later entry hides the earlier one, which is most likely unintended.
 %
+parser_e_tuple_needs_type=03377_E_Tuple fields need type annotation, e.g. (x, y, z: Integer)
+%
 % \end{description}
 %
 # Type Checking
 #
-# 04134 is the last used one
+# 04136 is the last used one
 #
 % \section{Type checking errors}
 % This section lists all errors that can occur when type checking is
@@ -2194,6 +2196,13 @@ type_e_cannot_determine_size_of_wasm_reference_type=04133_E_WebAssembly referenc
 % WebAssembly reference types are opaque, meaning neither their size, nor their bit pattern can be observed.
 type_e_ordinal_or_pointer_expr_expected=04134_E_Ordinal or pointer expression expected
 % The expression must be of an ordinal or pointer type.
+type_e_tuples_not_comparable=04135_E_Tuples have different shapes and cannot be compared
+% The two tuple operands have different field counts or field types,
+% so ordering comparison is not possible.
+type_e_tuple_index_must_be_const=04136_E_Tuple index must be a compile-time constant
+% Tuple fields can have different types, so the result type of t[i]
+% cannot be determined when i is a variable. Use a constant index
+% (t[0], t[1]) or named access (t._1, t._2).
 %
 % \end{description}
 #

compiler/nadd.pas

@@ -2194,12 +2194,166 @@ implementation
       end;
 
 
+    { builds a field-by-field equality/inequality chain for two tuple
+      records of identical shape; expects l and r already typechecked }
+    function build_tuple_eq_chain(l,r:tnode;wantequal:boolean):tnode;
+      var
+        recdef : trecorddef;
+        sym : tsym;
+        fsym : tfieldvarsym;
+        i,fcount : longint;
+        cmp,subl,subr,chain : tnode;
+      begin
+        recdef:=trecorddef(l.resultdef);
+        chain:=nil;
+        fcount:=0;
+        for i:=0 to recdef.symtable.symlist.count-1 do
+          begin
+            sym:=tsym(recdef.symtable.symlist[i]);
+            if sym.typ<>fieldvarsym then
+              continue;
+            fsym:=tfieldvarsym(sym);
+            subl:=csubscriptnode.create(fsym,l.getcopy);
+            subr:=csubscriptnode.create(fsym,r.getcopy);
+            if wantequal then
+              cmp:=caddnode.create(equaln,subl,subr)
+            else
+              cmp:=caddnode.create(unequaln,subl,subr);
+            if chain=nil then
+              chain:=cmp
+            else if wantequal then
+              chain:=caddnode.create(andn,chain,cmp)
+            else
+              chain:=caddnode.create(orn,chain,cmp);
+            inc(fcount);
+          end;
+        if chain=nil then
+          chain:=cordconstnode.create(ord(wantequal),pasbool1type,false);
+        l.free;
+        r.free;
+        result:=chain;
+      end;
+
+
+    { Recursively builds a lexicographic comparison chain:
+       (l.fi < r.fi) OR ((l.fi = r.fi) AND tail), with the last level
+       using last_op (< or <=). The caller provides the fieldsyms list
+       in order and starts at field_idx=0. }
+    function build_lex_rest(l,r:tnode;const fields:array of tfieldvarsym;
+      field_idx:longint;last_op:tnodetype):tnode;
+      var
+        subl,subr,subl_eq,subr_eq,eqcmp,ltcmp,tail : tnode;
+      begin
+        if field_idx=high(fields) then
+          begin
+            subl:=csubscriptnode.create(fields[field_idx],l.getcopy);
+            subr:=csubscriptnode.create(fields[field_idx],r.getcopy);
+            result:=caddnode.create(last_op,subl,subr);
+            exit;
+          end;
+        subl:=csubscriptnode.create(fields[field_idx],l.getcopy);
+        subr:=csubscriptnode.create(fields[field_idx],r.getcopy);
+        ltcmp:=caddnode.create(ltn,subl,subr);
+        subl_eq:=csubscriptnode.create(fields[field_idx],l.getcopy);
+        subr_eq:=csubscriptnode.create(fields[field_idx],r.getcopy);
+        eqcmp:=caddnode.create(equaln,subl_eq,subr_eq);
+        tail:=build_lex_rest(l,r,fields,field_idx+1,last_op);
+        result:=caddnode.create(orn,ltcmp,caddnode.create(andn,eqcmp,tail));
+      end;
+
+
+    { Expands a tuple < / <= / > / >= comparison into a lexicographic
+      chain. >  and >= are rewritten by swapping l and r so the chain
+      builder only needs to handle < and <=. }
+    function build_tuple_lex_chain(l,r:tnode;op:tnodetype):tnode;
+      var
+        recdef : trecorddef;
+        sym : tsym;
+        fields : array of tfieldvarsym;
+        i,fcount : longint;
+        last_op : tnodetype;
+        tmp : tnode;
+      begin
+        if op in [gtn,gten] then
+          begin
+            tmp:=l; l:=r; r:=tmp;
+            if op=gtn then op:=ltn else op:=lten;
+          end;
+        last_op:=op;
+        recdef:=trecorddef(l.resultdef);
+        fcount:=0;
+        setlength(fields,recdef.symtable.symlist.count);
+        for i:=0 to recdef.symtable.symlist.count-1 do
+          begin
+            sym:=tsym(recdef.symtable.symlist[i]);
+            if sym.typ=fieldvarsym then
+              begin
+                fields[fcount]:=tfieldvarsym(sym);
+                inc(fcount);
+              end;
+          end;
+        setlength(fields,fcount);
+        if fcount=0 then
+          result:=cordconstnode.create(0,pasbool1type,false)
+        else
+          result:=build_lex_rest(l,r,fields,0,last_op);
+        l.free;
+        r.free;
+      end;
+
+
     function taddnode.pass_typecheck:tnode;
       begin
         { This function is small to keep the stack small for recursive of
           large + operations }
         typecheckpass(left);
         typecheckpass(right);
+        { tuple equality / inequality }
+        if (nodetype in [equaln,unequaln]) and
+           assigned(left.resultdef) and assigned(right.resultdef) and
+           (left.resultdef.typ=recorddef) and (right.resultdef.typ=recorddef) and
+           (df_tuple in left.resultdef.defoptions) and
+           (df_tuple in right.resultdef.defoptions) then
+          begin
+            if tuples_have_equal_shape(trecorddef(left.resultdef),trecorddef(right.resultdef)) then
+              begin
+                result:=build_tuple_eq_chain(left,right,nodetype=equaln);
+                left:=nil;
+                right:=nil;
+                typecheckpass(result);
+              end
+            else
+              begin
+                { different shapes: always false for =, always true for <> }
+                left.free; left:=nil;
+                right.free; right:=nil;
+                result:=cordconstnode.create(ord(nodetype=unequaln),pasbool1type,false);
+              end;
+            exit;
+          end;
+        { tuple lexicographic ordering: < <= > >= }
+        if (nodetype in [ltn,lten,gtn,gten]) and
+           assigned(left.resultdef) and assigned(right.resultdef) and
+           (left.resultdef.typ=recorddef) and (right.resultdef.typ=recorddef) and
+           (df_tuple in left.resultdef.defoptions) and
+           (df_tuple in right.resultdef.defoptions) then
+          begin
+            if tuples_have_equal_shape(trecorddef(left.resultdef),trecorddef(right.resultdef)) then
+              begin
+                result:=build_tuple_lex_chain(left,right,nodetype);
+                left:=nil;
+                right:=nil;
+                typecheckpass(result);
+              end
+            else
+              begin
+                Message(type_e_tuples_not_comparable);
+                left.free; left:=nil;
+                right.free; right:=nil;
+                result:=cordconstnode.create(0,pasbool1type,false);
+              end;
+            exit;
+          end;
         result:=pass_typecheck_internal;
       end;
 

compiler/ngenutil.pas

@@ -523,8 +523,15 @@ implementation
            end;
          { units have separate code for initialization and finalization }
          potype_unitfinalize: ;
-         { program init/final is generated in separate procedure }
-         potype_proginit: ;
+         { program init/final is generated in separate procedure,
+           but block-scoped local vars (from inline var / for-in
+           destructuring) live on the stack and need explicit init }
+         potype_proginit:
+           begin
+             if assigned(pd.blocklocalsymtables) then
+               for blk_i:=0 to pd.blocklocalsymtables.count-1 do
+                 TSymtable(pd.blocklocalsymtables[blk_i]).SymList.ForEachCall(@sym_maybe_initialize,@stat);
+           end;
          else
            begin
              current_procinfo.procdef.localst.SymList.ForEachCall(@sym_maybe_initialize,@stat);
@@ -560,8 +567,14 @@ implementation
            end;
          { units/progs have separate code for initialization and finalization }
          potype_unitinit: ;
-         { program init/final is generated in separate procedure }
-         potype_proginit: ;
+         { program init/final is generated in separate procedure,
+           but block-scoped local vars need explicit finalization }
+         potype_proginit:
+           begin
+             if assigned(pd.blocklocalsymtables) then
+               for blk_i:=0 to pd.blocklocalsymtables.count-1 do
+                 TSymtable(pd.blocklocalsymtables[blk_i]).SymList.ForEachCall(@local_varsyms_finalize,@stat);
+           end;
          else
            begin
              current_procinfo.procdef.localst.SymList.ForEachCall(@local_varsyms_finalize,@stat);