diff tests/agcl/contrib/parse.syn @ 0:13d2b8934445

Import AnaGram (near-)release tree into Mercurial.
author David A. Holland
date Sat, 22 Dec 2007 17:52:45 -0500
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/agcl/contrib/parse.syn	Sat Dec 22 17:52:45 2007 -0500
@@ -0,0 +1,254 @@
+{
+/*
+ * AnaGram, A System for Syntax Directed Programming
+ * Copyright 1993-1994 Steve Holland. All rights reserved.
+ * See the file COPYING for license and usage terms.
+ */
+/* Embedded C code */
+#include <exec/lists.h>
+#include <intuition/classes.h>
+#include <proto/intuition.h>
+#include "OOLib.h"
+#include "Expr.h"
+#include "PushString.h"
+#include "ClassManager.h"
+#include "Driver/VariableClass.h"
+#include "Number.h"
+#include "Util.h"
+
+struct List ExprList;
+
+#define SYNTAX_ERROR fprintf(stderr,"%s, line %d, column %d\n",  (PCB).error_message, (PCB).line, (PCB).column)
+#define PARSER_STACK_OVERFLOW {fprintf(stderr,   "\nParser stack overflow, line %d, column %d\n",   (PCB).line, (PCB).column);}
+#define REDUCTION_TOKEN_ERROR {fprintf(stderr,    "\nReduction token error, line %d, column %d\n",    (PCB).line, (PCB).column);}
+
+Object *VariableProto=NULL; /* remember to initialize this */
+
+void Prepare_parse(void)
+{
+  VariableProto=NewObject(FindOOClass("numberclass"),NULL,NM_ID,VARIABLECLASS_ID,TAG_END);
+  if (!VariableProto) Warning(183,"Unable to create prototype variable object");
+  if (!ExprList.lh_Head) NewList(&ExprList);
+}
+
+void End_parse(void)
+{
+  if (VariableProto) DisposeObject(VariableProto);
+  VariableProto=NULL;
+}
+
+} /* End of embedded C */
+EOL = '\n'+'\r'
+DIGIT= '0-9'
+ALPHA='a-z'+'A-Z'
+GREEK=256..308
+RESERVED=','+';'+'='+'('+')'+'<'+'>'+'*'+'/'+'+'+'-'+0
+WS=' '+'\t'
+WSDISREGARD=WS+'\r'+'\n'
+/*ALNUM=ALPHA+DIGIT+GREEK*/
+ANYTHING=1..255+GREEK
+ALNUM=~(RESERVED+WSDISREGARD)
+
+[
+  disregard WhiteSpace
+  lexeme {VariNumStr}
+  parser stack size = 1000
+  sticky {StringBody}
+  ~allow macros
+  ~case sensitive
+  escape backslashes
+  line numbers path = "parse.syn"
+  line numbers
+]
+
+(void)LineParse $
+  -> Terminated Line..., 0
+
+Terminated Line
+  -> Line, ';'
+
+(void)Line
+  -> "DEFINE",VariNumStr:n,'(',VariableList:List,')',VariableList:LocList,'(',Group,')'
+  -> "PRINT",VariNumStr:func
+  -> "VAR", VariableDecl
+  -> "QUIT"                    = PCB.exit_flag=AG_SUCCESS_CODE;
+  -> Comparison = {
+                     Object *Result;
+                     struct ExprNode *Node;
+                     char *String=NULL;
+                     Result=EvalExpr(&ExprList);
+                     if (Result) {
+                       GetAttr(NM_NumberString,Result,(ULONG *)&String);
+                       if (String) printf("%s\n",String);
+                       DisposeObject(Result);
+                     }
+
+                     while (Node=(struct ExprNode *)RemHead(&ExprList)) {
+                       if (Node->Op != OP_FUNC && Node->Data) DisposeObject(Node->Data);
+                       Free(Node);
+                     }
+                  }
+
+(void)Group
+	-> Comparisons:a  = {ReverseTopExprStack(&ExprList,a);Push(&ExprList,OP_GROUP,a,NULL);}
+
+(struct LocaleNode *)VariableList
+  -> !{struct Locale *Locale;DoMethod(VariableProto,VCM_NEWLOCALE,&Locale);},VariableListWork = {struct LocaleNode *Locale;DoMethod(VariableProto,VCM_TAKELOCALE,NULL,&Locale);return Locale;}
+
+VariableListWork
+	->
+  -> VariListMemb
+	-> VariableListWork,',',VariListMemb
+
+VariableDecl
+  -> VariNumStr:Str         ={
+                               if (Str && GetString(Str)) {
+                                 NewObject(FindOOClass("numberclass"),NULL,
+                                   NM_ID,VARIABLECLASS_ID,
+                                   VA_Create,TRUE,
+                                   NM_NumberString,GetString(Str),
+                                   VA_NoObject,TRUE,
+                                   TAG_END);
+                                 DeleteString(Str);
+                               }
+                               else ParsePanic(PP_MEM);
+                             }
+
+  -> "const",VariNumStr:Str,'=',VariNum:Num ={
+                               Object *Const;
+                               if (Str && GetString(Str)) {
+                                 Const=NewObject(FindOOClass("numberclass"),NULL,
+                                   NM_ID,VARIABLECLASS_ID,
+                                   NM_NumberString,GetString(Str),
+                                   VA_Constant,TRUE,
+                                   VA_Create,TRUE,
+                                   TAG_END);
+                                 DeleteString(Str);
+                                 if (Const && Num) DoMethod(Const,VCM_ASSIGNFORCE,Num);
+                                 if (Const) DisposeObject(Const);
+                               }
+                               else ParsePanic(PP_MEM);
+                               if (Num) DisposeObject(Num);
+                             }
+
+
+(void)VariListMemb
+  -> VariNumStr:Str         ={
+                               if (Str && GetString(Str)) {
+                                 NewObject(FindOOClass("numberclass"),NULL,
+                                   NM_ID,VARIABLECLASS_ID,
+                                   VA_Create,TRUE,
+                                   NM_NumberString,GetString(Str),
+                                   VA_NoObject,TRUE,
+                                   TAG_END);
+                                 DeleteString(Str);
+                               }
+                               else ParsePanic(PP_MEM);
+                             }
+
+  -> "var",VariNumStr:Str   ={
+                               if (Str && GetString(Str)) {
+                                 NewObject(FindOOClass("numberclass"),NULL,
+                                   NM_ID,VARIABLECLASS_ID,
+                                   NM_NumberString,GetString(Str),
+                                   VA_ByReference,TRUE,
+                                   VA_Create,TRUE,
+                                   VA_NoObject,TRUE,
+                                   TAG_END);
+                                 DeleteString(Str);
+                               }
+                               else ParsePanic(PP_MEM);
+                             }
+  -> "const",VariNumStr:Str,VariNum:Num   ={
+                               Object *Const;
+                               if (Str && GetString(Str)) {
+                                 Const=NewObject(FindOOClass("numberclass"),NULL,
+                                   NM_ID,VARIABLECLASS_ID,
+                                   NM_NumberString,GetString(Str),
+                                   VA_Constant,TRUE,
+                                   VA_Create,TRUE,
+                                   TAG_END);
+                                 if (Const && Num) DoMethod(Const,VCM_ASSIGNFORCE,Num);
+                                 if (Const) DisposeObject(Const);
+                                 DeleteString(Str);
+                                 
+                               }
+                               else ParsePanic(PP_MEM);
+                               if (Num) DisposeObject(Num);
+                             }
+
+
+Comparison
+  -> Assignment
+  -> Comparison,'>',Assignment ={ReverseTopExprStack(&ExprList,2);Push(&ExprList,OP_FUNC,2,FUNC_GT);}
+  -> Comparison,'<',Assignment ={ReverseTopExprStack(&ExprList,2);Push(&ExprList,OP_FUNC,2,FUNC_LT);}
+  -> Comparison,"==",Assignment ={ReverseTopExprStack(&ExprList,2);Push(&ExprList,OP_FUNC,2,FUNC_COMP);}
+  -> Comparison,'>','=',Assignment ={ReverseTopExprStack(&ExprList,2);Push(&ExprList,OP_FUNC,2,FUNC_GTEQ);}
+  -> Comparison,'<','=',Assignment ={ReverseTopExprStack(&ExprList,2);Push(&ExprList,OP_FUNC,2,FUNC_LTEQ);}
+
+(int) Comparisons
+  -> Comparison =1;
+  -> Comparison, ';' =1;
+  -> Comparison, ';',Comparisons:n =n+1;
+
+Assignment
+  -> Expression
+  -> VariNum:s,'=',Expression ={Push(&ExprList,OP_ASSIGN,0,s);}
+
+(void)FunctionCall
+	-> VariNumStr:f,'(',ArgumentList:n,')' = {ReverseTopExprStack(&ExprList,n);Push(&ExprList,OP_FUNC,n,GetString(f));DeleteString(f);}
+
+(void)Expression
+	-> Product
+  -> Expression,'+',Product ={ReverseTopExprStack(&ExprList,2);Push(&ExprList,OP_FUNC,2,FUNC_ADD);}
+  -> Expression,'-',Product ={ReverseTopExprStack(&ExprList,2);Push(&ExprList,OP_FUNC,2,FUNC_SUB);}
+
+(unsigned)ArgumentList
+	-> =0;
+  -> Group ={return 1;}
+  -> Group,',',ArgumentList:a =a+1;
+
+(void)Product
+  -> PowerFactor
+  -> Product,'*',Factor = {ReverseTopExprStack(&ExprList,2);Push(&ExprList,OP_FUNC,2,FUNC_MUL);}
+  -> Product,'/',Factor = {ReverseTopExprStack(&ExprList,2);Push(&ExprList,OP_FUNC,2,FUNC_DIV);}
+
+(void)PowerFactor
+  -> Factor
+  -> '-',PowerFactor              = Push(&ExprList,OP_FUNC,1,FUNC_OPPOSITE);
+  -> PowerFactor,'^',Factor       ={ReverseTopExprStack(&ExprList,2);Push(&ExprList,OP_FUNC,2,FUNC_POW);}
+ 
+(void)Factor
+  -> '(',Group,')'
+  -> VariNum:Vari            = Push(&ExprList,OP_VAR,1,Vari);
+	-> FunctionCall
+
+
+(Object *)VariNum
+  -> VariNumStr:Str         ={
+                               Object *Result;
+                               if (Str && GetString(Str)) {
+                                 DiscardBlanks(Str);
+                                 Result=NewObject(FindOOClass("numberclass"),NULL,
+                                   NM_NumberString,GetString(Str),
+                                   TAG_END);
+                                 DeleteString(Str);
+                                 if (Result) return Result;
+                               }
+                               ParsePanic(PP_MEM);
+                               return NULL;
+                             }
+
+
+(struct String *)VariNumStr
+  -> StringBody:s = s;
+
+(struct String *) StringBody
+  -> ALNUM:c                ={struct String *String;String=CreateString();StringInsChar(String,strlen(GetString(String)),c);return String;}
+  -> StringBody:String,ALNUM:c     =StringInsChar(String,strlen(GetString(String)),c);
+  -> StringBody:String,WS:c        =StringInsChar(String,strlen(GetString(String)),c);
+
+WhiteSpace
+  -> WSDISREGARD
+  -> "/*",ANYTHING...,"*/"
+