Pragmas

src/code.c

@@ -893,6 +893,17 @@ void CodeFuncExprEnd(UInt nr)
 
 }
 
+void CodePragma(Obj content)
+{
+    Stat pragma;
+
+    pragma = NewStat( T_PRAGMA, SIZEBAG_STRINGLEN(GET_LEN_STRING(content)) );
+    memcpy( (void *)ADDR_STAT(pragma), CONST_ADDR_OBJ(content),
+            SIZEBAG_STRINGLEN(GET_LEN_STRING(content)) );
+
+    PushStat( pragma );
+}
+
 
 /****************************************************************************
 **

src/code.h

@@ -224,6 +224,8 @@ enum STAT_TNUM {
         T_INFO,
         T_ASSERT_2ARGS,
         T_ASSERT_3ARGS,
+
+        T_PRAGMA,
 
     END_ENUM_RANGE(LAST_STAT_TNUM),
 };
@@ -1374,6 +1376,8 @@ extern  void            CodeAssertEnd3Args ( void );
 /*  CodeContinue() .  . . . . . . . . . . . .  code continue-statement */
 extern  void            CodeContinue ( void );
 
+extern void CodePragma(Obj pragma);
+
 /****************************************************************************
 **
 *V  FilenameCache . . . . . . . . . . . . . . . . . . list of filenames

src/intrprtr.c

@@ -348,6 +348,15 @@ ExecStatus IntrEnd (
     return intrReturning;
 }
 
+/* Interpret a pragma, that is, if we're coding, code it, otherwise
+   ignore it */
+void IntrPragma(Obj pragma)
+{
+    /* ignore or code */
+    if ( STATE(IntrReturning) > 0 ) { return; }
+    if ( STATE(IntrIgnoring)  > 0 ) { return; }
+    if ( STATE(IntrCoding)    > 0 ) { CodePragma(pragma); return; }
+}
 
 /****************************************************************************
 **

src/intrprtr.h

@@ -974,6 +974,8 @@ extern void              IntrSaveWSEnd ( void );
 */
 extern void            IntrContinue ( void );
 
+extern void IntrPragma(Obj pragma);
+
 /****************************************************************************
 *F  PushVoidObj() . . . . . . . . . . . . . .  push void value onto the stack
 */

src/read.c

@@ -2494,6 +2494,14 @@ void ReadReturn (
     }
 }
 
+void ReadPragma(TypSymbolSet follow)
+{
+    Obj  pragma;
+
+    C_NEW_STRING( pragma, STATE(ValueLen), (void *)STATE(Value) );
+    Match(S_PRAGMA, "pragma", follow);
+    IntrPragma( pragma );
+}
 
 /****************************************************************************
 **
@@ -2594,7 +2602,8 @@ UInt ReadStats (
     /* read the statements                                                 */
     nr = 0;
     while ( IS_IN( STATE(Symbol), STATBEGIN|S_SEMICOLON ) ) {
-
+        if      ( STATE(Symbol) == S_PRAGMA ) ReadPragma(follow);
+        else { 
         /* read a statement                                                */
         if      ( STATE(Symbol) == S_IDENT  ) ReadCallVarAss(follow,'s');
         else if ( STATE(Symbol) == S_UNBIND ) ReadUnbind(    follow    );
@@ -2611,9 +2620,11 @@ UInt ReadStats (
         else if ( STATE(Symbol) == S_QUIT   ) ReadQuit(      follow    );
         else if ( STATE(Symbol) == S_ATOMIC ) ReadAtomic(    follow    );
         else if ( STATE(Symbol) == S_HELP   ) ReadHelp(      follow    );
+        else if ( STATE(Symbol) == S_PRAGMA ) ReadPragma(    follow    );
         else                           ReadEmpty(     follow    );
-        nr++;
         MatchSemicolon(follow);
+        }
+        nr++;
     }
 
     /* return the number of statements                                     */

src/scanner.c

@@ -974,6 +974,22 @@ void GetChar ( void )
   }
 }
 
+void GetPragma(void)
+{
+    Int i = 0;
+
+    /* Skip @ */
+    GET_CHAR();
+    while (*STATE(In) != '\n' && *STATE(In) != '\r' &&
+           *STATE(In) != '\377') {
+        STATE(Value)[i] = *STATE(In);
+        i++;
+        GET_CHAR();
+    }
+    STATE(Value)[i] = '\0';
+    STATE(ValueLen) = i;
+}
+
 void GetHelp( void )
 {
     Int i = 0;
@@ -1024,13 +1040,22 @@ void GetSymbol ( void )
       GET_CHAR();
     }
 
-  /* skip over <spaces>, <tabs>, <newlines> and comments                 */
-  while (*STATE(In)==' '||*STATE(In)=='\t'||*STATE(In)=='\n'||*STATE(In)=='\r'||*STATE(In)=='\f'||*STATE(In)=='#') {
-    if ( *STATE(In) == '#' ) {
-      while ( *STATE(In) != '\n' && *STATE(In) != '\r' && *STATE(In) != '\377' )
-        GET_CHAR();
-    }
-    GET_CHAR();
+  /* skip over <spaces>, <tabs>, <newlines> */
+  while (*STATE(In) == ' ' || *STATE(In) == '\t' || *STATE(In) == '\n' ||
+         *STATE(In) == '\r' || *STATE(In) == '\f' || *STATE(In) == '#') {
+      if (*STATE(In) == '#') {
+          GET_CHAR();
+          if (*STATE(In) == '@') {
+              STATE(Symbol) = S_PRAGMA;
+              GetPragma();
+              return;
+          } else {
+              while (*STATE(In) != '\n' && *STATE(In) != '\r' &&
+                     *STATE(In) != '\377')
+                  GET_CHAR();
+          }
+      }
+      GET_CHAR();
   }
 
   /* switch according to the character                                   */

src/scanner.h

@@ -135,6 +135,7 @@ enum SCANNER_SYMBOLS {
 
     S_SEMICOLON         = (1UL<<30)+0,
     S_DUALSEMICOLON     = (1UL<<30)+1,
+    S_PRAGMA            = (1UL<<30)+2,
 
     S_EOF               = (1UL<<31),
 };

src/stats.c

@@ -2009,6 +2009,16 @@ void            PrintAtomic (
     Pr( "%4<\nod;", 0L, 0L );
 }
 
+void PrintPragma(Stat stat)
+{
+    Char *pragma;
+
+    /* TODO: super ugly */
+    pragma = (Char *)((UInt *)(&ADDR_STAT(stat)[1]));
+
+    Pr("#@", 0L, 0L);
+    Pr("%s", (Int)(pragma), 0L);
+}
 
 /****************************************************************************
 **
@@ -2271,6 +2281,7 @@ static Int InitKernel (
     InstallExecStatFunc( T_RETURN_VOID    , ExecReturnVoid);
     InstallExecStatFunc( T_EMPTY          , ExecEmpty);
     InstallExecStatFunc( T_ATOMIC         , ExecAtomic);
+    InstallExecStatFunc( T_PRAGMA         , ExecEmpty);
 
     /* install printers for non-statements                                */
     for ( i = 0; i < ARRAY_SIZE(PrintStatFuncs); i++ ) {
@@ -2309,6 +2320,7 @@ static Int InitKernel (
     InstallPrintStatFunc( T_RETURN_VOID    , PrintReturnVoid);
     InstallPrintStatFunc( T_EMPTY          , PrintEmpty);
     InstallPrintStatFunc( T_ATOMIC         , PrintAtomic);
+    InstallPrintStatFunc( T_PRAGMA         , PrintPragma);
 
     for ( i = 0; i < ARRAY_SIZE(ExecStatFuncs); i++ )
         IntrExecStatFuncs[i] = ExecIntrStat;