Added pragmas

doc/ref/function.xml

@@ -184,4 +184,64 @@ there is one operation <Ref Attr="Zero"/> instead of two operations
 
 </Section>
 
+<!-- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -->
+<Section Label="Pragmas">
+<Heading>Code annotations (pragmas)</Heading>
+<Index>Pragmas</Index>
+<Index>Code annotations</Index>
+<Index>#%</Index>
+
+GAP supports the use of code annotations (pragmas) in functions, i.e.,
+adding comments to functions that are stored in the function object itself,
+unlike regular comments. Pragmas are single-line comments,
+starting with <C>#%</C>:
+<Example><![CDATA[
+gap> function()
+>       #% This is a pragma
+>       #  This is not a pragma
+>       return;
+> end;;
+gap> Display( last );
+function (  )
+    #% This is a pragma
+    return;
+end
+]]></Example>
+<P/>
+Pragmas can be used to mark parts of functions that should
+later be manipulated using <Ref Sect="Syntax Trees"/>.
+<P/>
+Please note that heavy use of pragmas in functions slows
+down the execution of your function in the same way as adding
+empty <C>;</C> statements to your code.
+<Log><![CDATA[
+gap> a := function( )
+>       local i;
+>       for i in [ 1 .. 1000000 ] do
+>               i := i + 1;
+>       od;
+> end;
+function(  ) ... end
+gap> a();
+gap> time;
+14
+gap> b := function( )
+>       local i;
+>       for i in [ 1 .. 1000000 ] do
+>               i := i + 1;
+>               #% pragma
+>               #% pragma
+>               #% pragma
+>               #% pragma
+>               #% pragma
+>       od;
+> end;
+function(  ) ... end
+gap> b();
+gap> time;
+25
+]]></Log>
+</Section>
+
+
 </Chapter>

doc/ref/language.xml

@@ -1965,7 +1965,7 @@ For examples of <K>return</K> statements, see the functions <C>fib</C> and
 
 </Section>
 
-<Section>
+<Section Label="Syntax Trees">
     <Heading>Syntax Trees</Heading>
 
     This section describes the tools available to handle &GAP; syntax trees.

src/code.c

@@ -1822,6 +1822,17 @@ void CodeStringExpr (
     PushExpr( string );
 }
 
+void CodePragma(Obj pragma)
+{
+    GAP_ASSERT(IS_STRING_REP(pragma));
+
+    Expr pragmaexpr = NewStat(T_PRAGMA, sizeof(UInt));
+    Int  ix = PushValue(pragma);
+    WRITE_EXPR(pragmaexpr, 0, ix);
+    PushStat(pragmaexpr);
+}
+
+
 /****************************************************************************
 **
 *F  CodeFloatExpr( <str> ) . . . . . . . .  code literal float expression

src/code.h

@@ -246,6 +246,7 @@ enum STAT_TNUM {
         T_INFO,
         T_ASSERT_2ARGS,
         T_ASSERT_3ARGS,
+        T_PRAGMA,
 
     END_ENUM_RANGE(LAST_STAT_TNUM),
 
@@ -1069,6 +1070,9 @@ void CodeListExprEnd(UInt nr, UInt range, UInt top, UInt tilde);
 */
 void CodeStringExpr(Obj str);
 
+void CodePragma(Obj pragma);
+
+
 /****************************************************************************
 **
 *F  CodeFloatExpr(<str>) . . . . . . . . . .  code literal float expression

src/intrprtr.c

@@ -2202,6 +2202,19 @@ void           IntrStringExpr (
     PushObj( string );
 }
 
+void           IntrPragma (
+    Obj               pragma )
+{
+    SKIP_IF_RETURNING();
+    SKIP_IF_IGNORING();
+    if ( STATE(IntrCoding)    > 0 ) {
+        CodePragma( pragma );
+    } else {
+        // Push a void when interpreting
+        PushVoidObj();
+    }
+}
+
 /****************************************************************************
 **
 *F  IntrRecExprBegin(<top>) . . . . . . . . . .  interpret record expr, begin

src/intrprtr.h

@@ -622,6 +622,8 @@ void IntrListExprEnd(UInt nr, UInt range, UInt top, UInt tilde);
 */
 void IntrStringExpr(Obj string);
 
+void IntrPragma(Obj pragma);
+
 
 /****************************************************************************
 **

src/io.c

@@ -258,7 +258,7 @@ Char GET_NEXT_CHAR(void)
 // GET_NEXT_CHAR_NO_LC is like GET_NEXT_CHAR, but does not handle
 // line continuations. This is used when skipping to the end of the
 // current line, when handling comment lines.
-static Char GET_NEXT_CHAR_NO_LC(void)
+Char GET_NEXT_CHAR_NO_LC(void)
 {
     if (STATE(In) == &IO()->Pushback) {
         STATE(In) = IO()->RealIn;

src/io.h

@@ -26,6 +26,7 @@
 
 
 Char GET_NEXT_CHAR(void);
+Char GET_NEXT_CHAR_NO_LC(void);
 Char PEEK_NEXT_CHAR(void);
 Char PEEK_CURR_CHAR(void);
 

src/read.c

@@ -2345,6 +2345,12 @@ static void ReadHelp(TypSymbolSet follow)
     STATE(ValueObj) = 0;
 }
 
+static void ReadPragma(TypSymbolSet follow)
+{
+    TRY_IF_NO_ERROR { IntrPragma(STATE(ValueObj)); }
+    STATE(ValueObj) = 0;
+}
+
 /****************************************************************************
 **
 *F  ReadQuit( <follow> )  . . . . . . . . . . . . . . . read a quit statement
@@ -2424,6 +2430,7 @@ static Int TryReadStatement(TypSymbolSet follow)
     case S_TRYNEXT:   ReadTryNext(   follow    ); break;
     case S_ATOMIC:    ReadAtomic(    follow    ); break;
     case S_SEMICOLON: ReadEmpty(     follow    ); break;
+    case S_PRAGMA:    ReadPragma(    follow    ); break;
     case S_QUIT:      SyntaxError("'quit;' cannot be used in this context"); break;
     case S_QQUIT:     SyntaxError("'QUIT;' cannot be used in this context"); break;
     case S_HELP:      SyntaxError("'?' cannot be used in this context"); break;
@@ -2443,7 +2450,12 @@ static UInt ReadStats (
             SyntaxError("statement expected");
         }
         nr++;
-        MatchSemicolon(follow);
+        if( STATE(Symbol) != S_PRAGMA ){
+            MatchSemicolon(follow);
+        }
+        else {
+            Match(S_PRAGMA, "", 0L );
+        }
     }
 
     // return the number of statements
@@ -2557,6 +2569,7 @@ ExecStatus ReadEvalCommand(Obj context, Obj *evalResult, UInt *dualSemicolon)
     case S_QUIT:      ReadQuit(    S_SEMICOLON|S_EOF      ); break;
     case S_QQUIT:     ReadQUIT(    S_SEMICOLON|S_EOF      ); break;
     case S_HELP:      ReadHelp(    S_SEMICOLON|S_EOF      ); break;
+    case S_PRAGMA:    ReadPragma(  S_SEMICOLON|S_EOF      ); break;
 
     // otherwise try to read a generic statement
     default:
@@ -2567,7 +2580,7 @@ ExecStatus ReadEvalCommand(Obj context, Obj *evalResult, UInt *dualSemicolon)
     }
 
     /* every statement must be terminated by a semicolon                  */
-    if (!IS_IN(STATE(Symbol), S_SEMICOLON) && STATE(Symbol) != S_HELP) {
+    if (!IS_IN(STATE(Symbol), S_SEMICOLON) && STATE(Symbol) != S_HELP && STATE(Symbol) != S_PRAGMA) {
         SyntaxError( "; expected");
     }
 

src/scanner.c

@@ -746,6 +746,30 @@ static void GetStr(void)
     }
 }
 
+
+static void GetPragma(void)
+{
+    Obj  string = 0;
+    Char buf[1024];
+    UInt i = 0;
+    Char c = PEEK_CURR_CHAR();
+
+    while ( c != '\n' && c != '\r' && c != '\f' && c != '\t' && c != '\377') {
+        i = AddCharToBuf(&string, buf, sizeof(buf), i, c);
+
+        // read the next character
+        c = GET_NEXT_CHAR();
+    }
+
+    // append any remaining data to STATE(ValueObj)
+    STATE(ValueObj) = AppendBufToString(string, buf, i);
+
+    if (c == '\377') {
+        *STATE(In) = '\0';
+    }
+}
+
+
 /****************************************************************************
 **
 *F  GetTripStr() . . . . . . . . . . . . .  get a triple quoted string, local
@@ -945,8 +969,16 @@ static UInt NextSymbol(void)
 
     // skip over <spaces>, <tabs>, <newlines> and comments
     while (c == ' ' || c == '\t' || c== '\n' || c== '\r' || c == '\f' || c=='#') {
-        if (c == '#')
+        if (c == '#') {
+            c = GET_NEXT_CHAR_NO_LC();
+            if (c == '%') {
+                // we have encountered a pragma
+                GetPragma();
+                return S_PRAGMA;
+            }
+
             SKIP_TO_END_OF_LINE();
+        }
         c = GET_NEXT_CHAR();
     }
 

src/scanner.h

@@ -63,6 +63,8 @@ enum SCANNER_SYMBOLS {
     S_STRING            = (1UL<<11)+3,
     S_TILDE             = (1UL<<11)+4,
     S_HELP              = (1UL<<11)+5,
+    S_PRAGMA            = (1UL<<11)+6,
+
 
     S_REC               = (1UL<<12)+0,
 

src/stats.c

@@ -1514,6 +1514,13 @@ static void PrintReturnVoid(Stat stat)
     Pr( "return;", 0L, 0L );
 }
 
+static void PrintPragma(Expr expr)
+{
+    UInt ix = READ_EXPR(expr, 0);
+    Obj string = GET_VALUE_FROM_CURRENT_BODY(ix);
+
+    Pr("#%g", (Int)string, 0);
+}
 
 /****************************************************************************
 **
@@ -1576,6 +1583,7 @@ static Int InitKernel (
     InstallExecStatFunc( T_RETURN_OBJ     , ExecReturnObj);
     InstallExecStatFunc( T_RETURN_VOID    , ExecReturnVoid);
     InstallExecStatFunc( T_EMPTY          , ExecEmpty);
+    InstallExecStatFunc( T_PRAGMA         , ExecEmpty);
 #ifdef HPCGAP
     InstallExecStatFunc( T_ATOMIC         , ExecAtomic);
 #endif
@@ -1616,6 +1624,7 @@ static Int InitKernel (
     InstallPrintStatFunc( T_RETURN_OBJ     , PrintReturnObj);
     InstallPrintStatFunc( T_RETURN_VOID    , PrintReturnVoid);
     InstallPrintStatFunc( T_EMPTY          , PrintEmpty);
+    InstallPrintStatFunc( T_PRAGMA         , PrintPragma);
 #ifdef HPCGAP
     InstallPrintStatFunc( T_ATOMIC         , PrintAtomic);
 #endif

src/syntaxtree.c

@@ -272,6 +272,14 @@ static Obj SyntaxTreeIf(Obj result, Stat stat)
     return result;
 }
 
+static Obj SyntaxTreeCompilePragma(Obj result, Stat stat)
+{
+    Obj message = GET_VALUE_FROM_CURRENT_BODY(READ_EXPR(stat, 0));
+    AssPRec(result, RNamName("value"), message);
+    return result;
+}
+
+
 static Obj SyntaxTreeFunc(Obj result, Obj func)
 {
     Obj stats;
@@ -412,6 +420,8 @@ static const CompilerT Compilers[] = {
     COMPILER_(
         T_ASSERT_3ARGS, ARG_("level"), ARG_("condition"), ARG_("message")),
 
+    COMPILER(T_PRAGMA, SyntaxTreeCompilePragma),
+
     /* Statements */
     COMPILER_(T_FUNCCALL_0ARGS, ARG_("funcref"), ARGS("args")),
     COMPILER_(T_FUNCCALL_1ARGS, ARG_("funcref"), ARGS("args")),

tst/testinstall/pragma.tst

@@ -0,0 +1,12 @@
+#
+gap> #% pragma
+gap> 
+gap> x := function( x )
+>       #% pragma
+>       return x;
+>    end;;
+gap> Display( x );
+function ( x )
+    #% pragma
+    return x;
+end