Added pragmas

Functions can contain pragmas, i.e., comments
which are stored inside the "compiled" function
as a string

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

@@ -2201,6 +2201,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

@@ -1513,6 +1513,14 @@ 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( "#", 0L, 0L );
+    Pr( CSTR_STRING( string ), 0L, 0L );
+}
 
 /****************************************************************************
 **
@@ -1575,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
@@ -1615,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,13 @@ 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 +419,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