diff --git a/src/code.c b/src/code.c index 265a26bea2f..e23c707f20d 100644 --- a/src/code.c +++ b/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( ) . . . . . . . . code literal float expression diff --git a/src/code.h b/src/code.h index 124cbf9561e..d275e07598f 100644 --- a/src/code.h +++ b/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() . . . . . . . . . . code literal float expression diff --git a/src/intrprtr.c b/src/intrprtr.c index a57e8a8661a..5483cce91c2 100644 --- a/src/intrprtr.c +++ b/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() . . . . . . . . . . interpret record expr, begin diff --git a/src/intrprtr.h b/src/intrprtr.h index a2b4d01d423..c06b66509ef 100644 --- a/src/intrprtr.h +++ b/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); + /**************************************************************************** ** diff --git a/src/io.c b/src/io.c index 1e9126f7d0f..70191ff4be3 100644 --- a/src/io.c +++ b/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; diff --git a/src/io.h b/src/io.h index 2453076b867..c1dbb9de759 100644 --- a/src/io.h +++ b/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); diff --git a/src/read.c b/src/read.c index 8638a468b6d..2beb74aaf4d 100644 --- a/src/read.c +++ b/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( ) . . . . . . . . . . . . . . . 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"); } diff --git a/src/scanner.c b/src/scanner.c index 9b514dc5db4..7774fef170e 100644 --- a/src/scanner.c +++ b/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 , , 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(); } diff --git a/src/scanner.h b/src/scanner.h index 77b4f704c8b..098031ad8f7 100644 --- a/src/scanner.h +++ b/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, diff --git a/src/stats.c b/src/stats.c index 8311ce411f2..e26812e866a 100644 --- a/src/stats.c +++ b/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 diff --git a/src/syntaxtree.c b/src/syntaxtree.c index 5a93d372070..b3bae2d2830 100644 --- a/src/syntaxtree.c +++ b/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")), diff --git a/tst/testinstall/pragma.tst b/tst/testinstall/pragma.tst new file mode 100644 index 00000000000..ec20fcb7f3d --- /dev/null +++ b/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