* new syntax with generic and specialize keywordgenerics

git-svn-id: http://svn.freepascal.org/svn/fpc/branches/generics@2018 3ad0048d-3df7-0310-abae-a5850022a9f2

5 files changed, 58 insertions, 15 deletions

diff --git a/compiler/pdecl.pas b/compiler/pdecl.pas
index 894f406ee0..e5be2260eb 100644
--- a/compiler/pdecl.pas
+++ b/compiler/pdecl.pas
@@ -369,6 +369,22 @@ implementation
 
     { reads a type declaration to the symbol table }
     procedure type_dec;
+
+        function parse_generic_parameters:tsinglelist;
+        var
+          generictype : ttypesym;
+        begin
+          result:=tsinglelist.create;
+          repeat
+            if token=_ID then
+              begin
+                generictype:=ttypesym.create(orgpattern,cundefinedtype);
+                result.insert(generictype);
+              end;
+            consume(_ID);
+          until not try_to_consume(_COMMA) ;
+        end;
+
       var
          typename,orgtypename : stringid;
          newtype  : ttypesym;
@@ -379,10 +395,8 @@ implementation
          defpos,storetokenpos : tfileposinfo;
          old_block_type : tblock_type;
          ch       : tclassheader;
-         unique,
-         isgeneric,
+         isunique,
          istyperenaming : boolean;
-         generictype : ttypesym;
          generictypelist : tsinglelist;
          generictokenbuf : tdynamicarray;
       begin
@@ -393,7 +407,6 @@ implementation
          repeat
            defpos:=akttokenpos;
            istyperenaming:=false;
-           isgeneric:=false;
            generictypelist:=nil;
            generictokenbuf:=nil;
 
@@ -401,20 +414,27 @@ implementation
            orgtypename:=orgpattern;
            consume(_ID);
 
+{$ifdef GENERICSHARPBRACKET}
            { Generic type declaration? }
            if try_to_consume(_LSHARPBRACKET) then
              begin
-               isgeneric:=true;
-               generictypelist:=tsinglelist.create;
-               generictype:=ttypesym.create(orgpattern,cundefinedtype);
-               generictypelist.insert(generictype);
-               consume(_ID);
+               generictypelist:=parse_generic_parameters;
                consume(_RSHARPBRACKET);
              end;
+{$endif GENERICSHARPBRACKET}
 
            consume(_EQUAL);
+
            { support 'ttype=type word' syntax }
-           unique:=try_to_consume(_TYPE);
+           isunique:=try_to_consume(_TYPE);
+
+           { Generic type declaration? }
+           if try_to_consume(_GENERIC) then
+             begin
+               consume(_LKLAMMER);
+               generictypelist:=parse_generic_parameters;
+               consume(_RKLAMMER);
+             end;
 
            { MacPas object model is more like Delphi's than like TP's, but }
            { uses the object keyword instead of class                      }
@@ -422,7 +442,8 @@ implementation
               (token = _OBJECT) then
              token := _CLASS;
 
-           if isgeneric then
+           { Start recording a generic template }
+           if assigned(generictypelist) then
              begin
                generictokenbuf:=tdynamicarray.create(256);
                current_scanner.startrecordtokens(generictokenbuf);
@@ -472,7 +493,7 @@ implementation
                 istyperenaming:=true
               else
                 tt.sym:=newtype;
-              if unique and assigned(tt.def) then
+              if isunique and assigned(tt.def) then
                 begin
                    tt.setdef(tstoreddef(tt.def).getcopy);
                    include(tt.def.defoptions,df_unique);
@@ -522,7 +543,8 @@ implementation
               end;
             end;
 
-           if isgeneric then
+           { Stop recording a generic template }
+           if assigned(generictypelist) then
              begin
                current_scanner.stoprecordtokens;
                tstoreddef(tt.def).generictokenbuf:=generictokenbuf;
diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas
index 97f5cf381a..b22341a627 100644
--- a/compiler/pexpr.pas
+++ b/compiler/pexpr.pas
@@ -1311,7 +1311,8 @@ implementation
                        if (htype.def=cvarianttype.def) and
                           not(cs_compilesystem in aktmoduleswitches) then
                          current_module.flags:=current_module.flags or uf_uses_variants;
-                       if try_to_consume(_LKLAMMER) then
+                       if (block_type<>bt_type) and
+                          try_to_consume(_LKLAMMER) then
                         begin
                           p1:=comp_expr(true);
                           consume(_RKLAMMER);
diff --git a/compiler/psub.pas b/compiler/psub.pas
index d587c80a83..ff818d08e6 100644
--- a/compiler/psub.pas
+++ b/compiler/psub.pas
@@ -1575,6 +1575,7 @@ implementation
                  internalerror(200512111);
                oldaktfilepos:=aktfilepos;
                aktfilepos:=tprocdef(tprocdef(hp).genericdef).fileinfo;
+               akttokenpos:=aktfilepos;
                current_scanner.startreplaytokens(tprocdef(tprocdef(hp).genericdef).generictokenbuf);
                read_proc_body(nil,tprocdef(hp));
                aktfilepos:=oldaktfilepos;
diff --git a/compiler/ptype.pas b/compiler/ptype.pas
index ac06e46166..c9494501a5 100644
--- a/compiler/ptype.pas
+++ b/compiler/ptype.pas
@@ -91,15 +91,24 @@ implementation
             Comment(V_Error,'Specialization is only supported for generic types');
             pt1.resulttype:=generrortype;
             { recover }
+{$ifdef GENERICSHARPBRACKET}
             consume(_LSHARPBRACKET);
+{$endif GENERICSHARPBRACKET}
+            consume(_LKLAMMER);
             repeat
               pt2:=factor(false);
               pt2.free;
             until not try_to_consume(_COMMA);
+{$ifdef GENERICSHARPBRACKET}
             consume(_RSHARPBRACKET);
+{$endif GENERICSHARPBRACKET}
+            consume(_RKLAMMER);
             exit;
           end;
+{$ifdef GENERICSHARPBRACKET}
         consume(_LSHARPBRACKET);
+{$endif GENERICSHARPBRACKET}
+        consume(_LKLAMMER);
         { Parse generic parameters, for each undefineddef in the symtable of
           the genericdef we need to have a new def }
         err:=false;
@@ -151,7 +160,10 @@ implementation
             try_to_consume(_SEMICOLON);
           end;
         generictypelist.free;
+{$ifdef GENERICSHARPBRACKET}
         consume(_RSHARPBRACKET);
+{$endif GENERICSHARPBRACKET}
+        consume(_RKLAMMER);
       end;
 
 
@@ -346,6 +358,7 @@ implementation
         var
            pt1,pt2 : tnode;
            lv,hv   : TConstExprInt;
+           ispecialization : boolean;
         begin
            { use of current parsed object ? }
            if (token=_ID) and (testcurobject=2) and (curobjectname=pattern) then
@@ -361,6 +374,8 @@ implementation
                 consume(_ID);
                 exit;
              end;
+           { Generate a specialization? }
+           ispecialization:=try_to_consume(_SPECIALIZE);
            { we can't accept a equal in type }
            pt1:=comp_expr(not(ignore_equal));
            if (token=_POINTPOINT) then
@@ -411,7 +426,7 @@ implementation
                { a simple type renaming or generic specialization }
                if (pt1.nodetype=typen) then
                  begin
-                   if token=_LSHARPBRACKET then
+                   if ispecialization then
                      generate_specialization(pt1,name);
                    tt:=ttypenode(pt1).resulttype;
                  end
diff --git a/compiler/tokens.pas b/compiler/tokens.pas
index b8ea8e9484..1ad2b02453 100644
--- a/compiler/tokens.pas
+++ b/compiler/tokens.pas
@@ -179,6 +179,7 @@ type
     _EXPORTS,
     _FINALLY,
     _FORWARD,
+    _GENERIC,
     _IOCHECK,
     _LIBRARY,
     _MESSAGE,
@@ -227,6 +228,7 @@ type
     _INTERNPROC,
     _OLDFPCCALL,
     _OPENSTRING,
+    _SPECIALIZE,
     _CONSTRUCTOR,
     _INTERNCONST,
     _REINTRODUCE,
@@ -421,6 +423,7 @@ const
       (str:'EXPORTS'       ;special:false;keyword:m_all;op:NOTOKEN),
       (str:'FINALLY'       ;special:false;keyword:m_class;op:NOTOKEN),
       (str:'FORWARD'       ;special:false;keyword:m_none;op:NOTOKEN),
+      (str:'GENERIC'       ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'IOCHECK'       ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'LIBRARY'       ;special:false;keyword:m_all;op:NOTOKEN),
       (str:'MESSAGE'       ;special:false;keyword:m_none;op:NOTOKEN),
@@ -469,6 +472,7 @@ const
       (str:'INTERNPROC'    ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'OLDFPCCALL'    ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'OPENSTRING'    ;special:false;keyword:m_none;op:NOTOKEN),
+      (str:'SPECIALIZE'    ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'CONSTRUCTOR'   ;special:false;keyword:m_all;op:NOTOKEN),
       (str:'INTERNCONST'   ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'REINTRODUCE'   ;special:false;keyword:m_none;op:NOTOKEN),