summaryrefslogtreecommitdiff
path: root/examples/AGRS/Library.Mod
diff options
context:
space:
mode:
Diffstat (limited to 'examples/AGRS/Library.Mod')
-rw-r--r--examples/AGRS/Library.Mod677
1 files changed, 677 insertions, 0 deletions
diff --git a/examples/AGRS/Library.Mod b/examples/AGRS/Library.Mod
new file mode 100644
index 0000000..fc3fc88
--- /dev/null
+++ b/examples/AGRS/Library.Mod
@@ -0,0 +1,677 @@
+MODULE Library;
+IMPORT AGRS,Names,Texts,TextFrames;
+
+
+CONST
+ (* Kodovi gresaka koji su sadrzani u tipu podataka Error. *)
+ NotLogicalType*= 0;
+ NotNumberType*= 1;
+ NotCharacterType*= 2;
+ NotStringType*= 3;
+ NotTextType*= 4;
+ NotFound*= 5;
+ SyntaxError*= 6;
+
+ CharSetLength= 256 DIV (MAX(SET)+1);
+
+TYPE
+ Term= AGRS.Term;
+ ErrorType= INTEGER;
+
+ NamesType= POINTER TO RECORD(AGRS.ClosedClassDesc)
+ END;
+
+ Number*= POINTER TO RECORD(AGRS.AtomicDesc)
+ value*: INTEGER;
+ END;
+
+ String*= POINTER TO RECORD(AGRS.AtomicDesc)
+ value-: Names.CharPtr;
+ END;
+
+ Text*= POINTER TO RECORD(AGRS.AtomicDesc)
+ base-: Texts.Text;
+ startOffset-,endOffset-: LONGINT;
+ END;
+
+ Character*= POINTER TO RECORD(AGRS.AtomicDesc)
+ value-: CHAR;
+ END;
+
+ CharSet*= POINTER TO RECORD( AGRS.AtomicDesc)
+ value-: ARRAY CharSetLength OF SET;
+ END;
+
+ Error*= POINTER TO RECORD(AGRS.AtomicDesc)
+ value-: ErrorType;
+ END;
+
+ BinOp= POINTER TO RECORD(AGRS.TermDesc)
+ END;
+VAR
+ TrueDef: Term;
+
+ disTerm: AGRS.Disjunction;
+ NamesTerm: NamesType;
+
+ atomicName,numberName*,errorName*: AGRS.Name;
+ charName*,stringName*,textName*,charSetName*: AGRS.Name;
+ ifName,orName,andName,notName,testName,yesName,noName: AGRS.Name;
+ addName*,subName*,mulName*,divName,modName: AGRS.Name;
+ argName1*,argName2*: AGRS.Name;
+ equalName,lessName,greaterName,lessEqName,grEqName: AGRS.Name;
+ trueName*,disName,unifyName: AGRS.Name;
+ abortName*,findName,nameName: AGRS.Name;
+ carName,cdrName,consName,nilName: AGRS.Name;
+ namesName: AGRS.Name;
+
+
+
+PROCEDURE NewNumber*(v: INTEGER): Number;
+VAR
+ result: Number;
+BEGIN
+ NEW(result);
+ result.Init(numberName);
+ result.value:= v;
+ AGRS.eldestAsked:= AGRS.Fixed;
+ RETURN result;
+END NewNumber;
+
+PROCEDURE NewString*(v: Names.CharPtr): String;
+VAR
+ result: String;
+BEGIN
+ NEW(result);
+ result.Init(stringName);
+ result.value:= v;
+ AGRS.eldestAsked:= AGRS.Fixed;
+ RETURN result;
+END NewString;
+
+PROCEDURE NewChar*(v: CHAR): Character;
+VAR
+ result: Character;
+BEGIN
+ NEW(result);
+ result.Init(charName);
+ result.value:= v;
+ AGRS.eldestAsked:= AGRS.Fixed;
+ RETURN result;
+END NewChar;
+
+PROCEDURE NewCharSet*(): CharSet;
+VAR
+ result: CharSet;
+ i: INTEGER;
+BEGIN
+ NEW(result);
+ result.Init(charSetName);
+ FOR i:= 0 TO CharSetLength-1 DO
+ result.value[i]:= {};
+ END;
+ AGRS.eldestAsked:= AGRS.Fixed;
+ RETURN result;
+END NewCharSet;
+
+
+PROCEDURE (t: String) Length*(): LONGINT;
+VAR
+ i: LONGINT;
+ str: Names.CharPtr;
+BEGIN
+ i:= 0;
+ str:= t.value;
+ WHILE str[i]#0X DO
+ INC(i);
+ END;
+ RETURN i
+END Length;
+
+
+PROCEDURE (t: CharSet) Include*(ch: CHAR);
+BEGIN
+ INCL(t.value[ORD(ch) DIV (MAX(SET)+1)],ORD(ch) MOD (MAX(SET)+1));
+END Include;
+
+PROCEDURE (t: CharSet) Complement*();
+VAR
+ i: INTEGER;
+BEGIN
+ FOR i:= 0 TO CharSetLength-1 DO
+ t.value[i]:= -t.value[i];
+ END;
+END Complement;
+
+PROCEDURE NewError*(v: ErrorType): Error;
+VAR
+ result: Error;
+BEGIN
+ NEW(result);
+ result.Init(errorName);
+ AGRS.eldestAsked:= AGRS.Fixed;
+ result.value:= v;
+ RETURN result
+END NewError;
+
+PROCEDURE SubText*(txt: Texts.Text; startPos,endPos: LONGINT): Text;
+VAR
+ newTerm: Text;
+BEGIN
+ NEW(newTerm);
+ newTerm.Init(textName);
+ newTerm.base:= txt;
+ newTerm.startOffset:= startPos;
+ newTerm.endOffset:= endPos;
+ RETURN newTerm
+END SubText;
+
+
+PROCEDURE (t: Text) AppendText*(appendage: Text);
+VAR
+ temp: Texts.Buffer;
+ newText: Texts.Text;
+BEGIN
+ IF (t.base=appendage.base) & (t.endOffset=appendage.startOffset) THEN
+ t.endOffset:= appendage.endOffset;
+ ELSE
+ newText:= TextFrames.Text("");
+ NEW(temp);
+ Texts.OpenBuf(temp);
+ Texts.Save(t.base,t.startOffset,t.endOffset,temp);
+ Texts.Save(appendage.base,appendage.startOffset,appendage.endOffset,temp);
+ Texts.Append(newText,temp);
+ t.base:= newText;
+ t.startOffset:= 0;
+ t.endOffset:= newText.len;
+ END;
+END AppendText;
+
+PROCEDURE (t: Text) AppendBuffer*(appendage: Texts.Buffer);
+VAR
+ newText: Texts.Text;
+BEGIN
+ IF t.endOffset=t.base.len THEN
+ Texts.Append(t.base,appendage);
+ t.endOffset:= t.base.len;
+ ELSE
+ newText:= TextFrames.Text("");
+ Texts.Append(newText,appendage);
+ t.base:= newText;
+ t.startOffset:= 0;
+ t.endOffset:= newText.len;
+ END;
+END AppendBuffer;
+
+
+PROCEDURE (t: NamesType) Evaluate*(query: Term): Term;
+BEGIN
+ RETURN NewString(Names.NameSpelling(query.indirection))
+END Evaluate;
+
+
+PROCEDURE pType;
+VAR
+ newTerm: AGRS.OpenTree;
+BEGIN
+ NEW(newTerm);
+ newTerm.Init(AGRS.lastResult);
+ AGRS.result:= newTerm;
+END pType;
+
+
+PROCEDURE (t: Character) Compare*(reference: Term; VAR lessEq,grEq: BOOLEAN);
+BEGIN
+ WITH reference: Character DO
+ lessEq:= t.value<=reference.value;
+ grEq:= t.value>=reference.value;
+ ELSE
+ WITH reference: String DO
+ lessEq:= t.value<=reference.value[0];
+ grEq:= t.value>=reference.value[0];
+ IF lessEq & grEq THEN
+ grEq:= reference.value[1]=0X;
+ END;
+ ELSE
+ lessEq:= FALSE;
+ grEq:= FALSE;
+ END;
+ END;
+END Compare;
+
+PROCEDURE (t: String) Compare*(reference: AGRS.Term; VAR lessEq,grEq: BOOLEAN);
+VAR
+ i: INTEGER;
+BEGIN
+ WITH reference: Character DO
+ lessEq:= t.value[0]<=reference.value;
+ grEq:= t.value[0]>=reference.value;
+ IF lessEq & grEq THEN
+ lessEq:= t.value[1]=0X;
+ END;
+ ELSE
+ WITH reference: String DO
+ i:= 0;
+ WHILE (t.value[i]=reference.value[i]) & (t.value[i]#0X) DO
+ INC(i);
+ END;
+ lessEq:= (t.value[i]<=reference.value[i]);
+ grEq:= (t.value[i]>=reference.value[i]);
+ ELSE
+ lessEq:= FALSE;
+ grEq:= FALSE;
+ END;
+ END;
+END Compare;
+
+PROCEDURE (t: Number) Compare*(reference: Term; VAR lessEq,grEq: BOOLEAN);
+BEGIN
+ WITH reference: Number DO
+ lessEq:= t.value<=reference.value;
+ grEq:= t.value>=reference.value;
+ ELSE
+ lessEq:= FALSE;
+ grEq:= FALSE;
+ END;
+END Compare;
+
+PROCEDURE (t: CharSet) Compare*(reference: Term; VAR lessEq,grEq: BOOLEAN);
+VAR
+ i: INTEGER;
+BEGIN
+ lessEq:= TRUE;
+ grEq:= TRUE;
+ WITH reference: CharSet DO
+ FOR i:= 0 TO CharSetLength-1 DO
+ IF t.value[i]-reference.value[i]#{} THEN
+ lessEq:= FALSE;
+ END;
+ IF reference.value[i]-t.value[i]#{} THEN
+ grEq:= FALSE;
+ END;
+ END;
+ ELSE
+ END;
+END Compare;
+
+PROCEDURE (t: Error) Compare*(reference: Term; VAR lessEq,grEq: BOOLEAN);
+BEGIN
+ WITH reference: Error DO
+ lessEq:= t.value<=reference.value;
+ grEq:= t.value>=reference.value;
+ ELSE
+ lessEq:= FALSE;
+ grEq:= FALSE;
+ END;
+END Compare;
+
+
+PROCEDURE pEqual;
+VAR
+ t1,t2: AGRS.Term;
+BEGIN
+ t1:= argName1.Value();
+ t2:= argName2.Value();
+ IF AGRS.Equal(t1,t2) THEN
+ TrueDef.Reduce;
+ ELSE
+ AGRS.Fail;
+ END;
+END pEqual;
+
+PROCEDURE pLess;
+VAR
+ t1,t2: AGRS.Term;
+ lessEq,grEq: BOOLEAN;
+BEGIN
+ t1:= argName1.Value();
+ WITH t1: AGRS.Atomic DO
+ t2:= argName2.Value();
+ t1.Compare(t2,lessEq,grEq);
+ IF lessEq & ~grEq THEN
+ TrueDef.Reduce;
+ RETURN
+ END;
+ END;
+ AGRS.Fail;
+END pLess;
+
+PROCEDURE pGreater;
+VAR
+ t1,t2: AGRS.Term;
+ lessEq,grEq: BOOLEAN;
+ oldStack: AGRS.TermStack;
+BEGIN
+ t1:= argName1.Value();
+ WITH t1: AGRS.Atomic DO
+ t2:= argName2.Value();
+ t1.Compare(t2,lessEq,grEq);
+ IF ~lessEq & grEq THEN
+ TrueDef.Reduce;
+ RETURN
+ END;
+ END;
+ AGRS.Fail;
+END pGreater;
+
+PROCEDURE pLessEq;
+VAR
+ t1,t2: AGRS.Term;
+ lessEq,grEq: BOOLEAN;
+BEGIN
+ t1:= argName1.Value();
+ WITH t1: AGRS.Atomic DO
+ t2:= argName2.Value();
+ t1.Compare(t2,lessEq,grEq);
+ IF lessEq THEN
+ TrueDef.Reduce;
+ RETURN
+ END;
+ END;
+ AGRS.Fail;
+END pLessEq;
+
+PROCEDURE pGrEq;
+VAR
+ t1,t2: AGRS.Term;
+ lessEq,grEq: BOOLEAN;
+BEGIN
+ t1:= argName1.Value();
+ WITH t1: AGRS.Atomic DO
+ t2:= argName2.Value();
+ t1.Compare(t2,lessEq,grEq);
+ IF grEq THEN
+ TrueDef.Reduce;
+ RETURN
+ END;
+ END;
+ AGRS.Fail;
+END pGrEq;
+
+PROCEDURE pNot;
+BEGIN
+ AGRS.result:= argName1.Value();
+ IF AGRS.result.indirection=trueName THEN
+ AGRS.result:= AGRS.Failure;
+ ELSIF AGRS.result.indirection=AGRS.failName THEN
+ AGRS.result:= TrueDef;
+ ELSE
+ AGRS.result:= NewError(NotLogicalType);
+ END;
+ AGRS.result.Reduce;
+END pNot;
+
+PROCEDURE pAnd;
+VAR
+ eldest1: INTEGER;
+BEGIN
+ AGRS.result:= argName1.Value();
+ IF AGRS.result.indirection=trueName THEN
+ eldest1:= AGRS.eldestAsked;
+ AGRS.result:= argName2.Value();
+ IF eldest1<AGRS.eldestAsked THEN
+ AGRS.eldestAsked:= eldest1;
+ END;
+ ELSIF AGRS.result.indirection#AGRS.failName THEN
+ AGRS.result:= NewError(NotLogicalType);
+ END;
+ AGRS.result.Reduce;
+END pAnd;
+
+PROCEDURE pOr;
+VAR
+ eldest1: INTEGER;
+BEGIN
+ AGRS.result:= argName1.Value();
+ IF AGRS.result.indirection=AGRS.failName THEN
+ eldest1:= AGRS.eldestAsked;
+ AGRS.result:= argName2.Value();
+ IF eldest1<AGRS.eldestAsked THEN
+ AGRS.eldestAsked:= eldest1;
+ END;
+ ELSIF AGRS.result.indirection#trueName THEN
+ AGRS.result:= NewError(NotLogicalType);
+ END;
+ AGRS.result.Reduce;
+END pOr;
+
+
+PROCEDURE pIf;
+VAR
+ eldest1: INTEGER;
+BEGIN
+ AGRS.result:= testName.Value();
+ eldest1:= AGRS.eldestAsked;
+ IF AGRS.result.indirection=trueName THEN
+ yesName.Reduce;
+ ELSIF AGRS.result.indirection=AGRS.failName THEN
+ noName.Reduce;
+ ELSE
+ AGRS.result:= NewError(NotLogicalType);
+ AGRS.result.Reduce;
+ END;
+ IF eldest1<AGRS.eldestAsked THEN
+ AGRS.eldestAsked:= eldest1;
+ END;
+END pIf;
+
+
+PROCEDURE ExtractNumbers(VAR x,y:INTEGER):BOOLEAN;
+VAR
+ eldest1: INTEGER;
+ arg: Term;
+BEGIN
+ arg:= argName1.Value();
+ WITH arg: Number DO
+ x:= arg.value;
+ ELSE
+ RETURN FALSE
+ END;
+ eldest1:= AGRS.eldestAsked;
+ arg:= argName2.Value();
+ WITH arg: Number DO
+ y:= arg.value;
+ ELSE
+ RETURN FALSE
+ END;
+ IF eldest1<AGRS.eldestAsked THEN
+ AGRS.eldestAsked:= eldest1;
+ END;
+ RETURN TRUE
+END ExtractNumbers;
+
+PROCEDURE ExtractNumbersFromStack(VAR x,y:INTEGER; VAR oldStack:AGRS.TermStack):BOOLEAN;
+VAR
+ arg: Term;
+BEGIN
+ IF (AGRS.paramStack=NIL) OR (AGRS.paramStack.rest=NIL) THEN
+ RETURN FALSE
+ END;
+ oldStack:= AGRS.paramStack;
+ arg:= AGRS.paramStack.top;
+ WITH arg: Number DO
+ x:= arg.value;
+ ELSE
+ RETURN FALSE
+ END;
+ AGRS.paramStack:= AGRS.paramStack.rest;
+ arg:= AGRS.paramStack.top;
+ WITH arg: Number DO
+ y:= arg.value;
+ ELSE
+ RETURN FALSE
+ END;
+ AGRS.paramStack:= AGRS.paramStack.rest;
+ RETURN TRUE
+END ExtractNumbersFromStack;
+
+PROCEDURE pAdd;
+VAR
+ x,y:INTEGER;
+ newTerm: Term;
+ oldStack: AGRS.TermStack;
+BEGIN
+ IF ExtractNumbers(x,y) THEN
+ newTerm:= NewNumber(x+y);
+ newTerm.Reduce;
+ ELSE
+ AGRS.Continue;
+ END;
+END pAdd;
+
+PROCEDURE pSub;
+VAR
+ x,y:INTEGER;
+ newTerm: Term;
+BEGIN
+ IF ExtractNumbers(x,y) THEN
+ newTerm:= NewNumber(x-y);
+ newTerm.Reduce;
+ ELSE
+ AGRS.Continue;
+ END;
+END pSub;
+
+PROCEDURE pMul;
+VAR
+ x,y:INTEGER;
+ newTerm: Term;
+BEGIN
+ IF ExtractNumbers(x,y) THEN
+ newTerm:= NewNumber(x*y);
+ newTerm.Reduce;
+ ELSE
+ AGRS.Continue;
+ END;
+END pMul;
+
+PROCEDURE pDiv;
+VAR
+ x,y:INTEGER;
+ newTerm: Term;
+BEGIN
+ IF ExtractNumbers(x,y) THEN
+ newTerm:= NewNumber(x DIV y);
+ newTerm.Reduce;
+ ELSE
+ AGRS.Continue;
+ END;
+END pDiv;
+
+PROCEDURE pMod;
+VAR
+ x,y:INTEGER;
+ newTerm: Term;
+BEGIN
+ IF ExtractNumbers(x,y) THEN
+ newTerm:= NewNumber(x MOD y);
+ newTerm.Reduce;
+ ELSE
+ AGRS.Continue;
+ END;
+END pMod;
+
+
+PROCEDURE pFind;
+VAR
+ s,n: Term;
+BEGIN
+ s:= nameName.Value();
+ WITH s: String DO
+ n:= Names.FindPublicName(s.value^);
+ IF n=NIL THEN
+ n:= NewError(NotFound);
+ END;
+ ELSE
+ n:= NewError(NotStringType);
+ END;
+ n.Reduce;
+END pFind;
+
+PROCEDURE pAbort;
+VAR
+ stack: AGRS.TermStack;
+BEGIN
+ stack:= AGRS.continuation;
+ HALT(255)
+END pAbort;
+
+PROCEDURE pUnify;
+BEGIN
+ AGRS.Push(trueName);
+ AGRS.Unify(argName1.indirection,argName2.Value());
+END pUnify;
+
+PROCEDURE (t: BinOp) Reduce*;
+BEGIN
+ AGRS.Push(t.indirection);
+ AGRS.Push(argName2.indirection);
+ argName1.Reduce;
+END Reduce;
+
+PROCEDURE AddBinOp(proc:AGRS.HandlerType; name,primName: ARRAY OF CHAR);
+VAR
+ newTerm: BinOp;
+ newName: AGRS.Name;
+BEGIN
+ Names.AddSystemName(newName,primName,proc);
+ NEW(newTerm);
+ newTerm.Init(newName);
+ Names.DefinePublicName(newName,name,newTerm);
+END AddBinOp;
+
+BEGIN
+ Names.AddSystemName(atomicName,'AtomSystemRoot',AGRS.AtomicHandler);
+ Names.DefinePublicName(textName,'TEXT',atomicName.indirection);
+ Names.DefinePublicName(stringName,'STRING',atomicName.indirection);
+ Names.DefinePublicName(charName,'CHAR',atomicName.indirection);
+ Names.DefinePublicName(charSetName,'CharSET',atomicName.indirection);
+ Names.DefinePublicName(errorName,'ERROR',atomicName.indirection);
+ Names.DefinePublicName(numberName,'NUMBER',atomicName.indirection);
+
+ Names.AddArgument(carName, 'Car');
+ Names.AddArgument(cdrName, 'Cdr');
+ Names.AddArgument(nilName, 'Nil');
+ Names.AddArgument(consName, 'Cons');
+
+ Names.AddArgument(trueName, 'True');
+ NEW(TrueDef);
+ TrueDef.Init(trueName);
+ Names.AddSystemName(andName, 'And', pAnd);
+ Names.AddSystemName(orName, 'Or', pOr);
+ Names.AddSystemName(notName, 'Not', pNot);
+ Names.AddSystemName(ifName, 'If', pIf);
+ Names.AddArgument(testName, 'Test');
+ Names.AddArgument(yesName, 'Yes');
+ Names.AddArgument(noName, 'No');
+
+ argName1:= Names.FindOrdinalName(1);
+ argName2:= Names.FindOrdinalName(2);
+
+ NEW(disTerm);
+ disTerm.Init(argName1);
+ disTerm.InitAlternative(argName2);
+ Names.DefinePublicName(disName, 'Dis', disTerm);
+
+ Names.AddSystemName(AGRS.failName,'Fail',AGRS.Fail);
+ Names.AddSystemName(unifyName, 'Unify', pUnify);
+ Names.AddSystemName(equalName, 'Equal', pEqual);
+ Names.AddSystemName(lessName, 'Less', pLess);
+ Names.AddSystemName(greaterName, 'Greater', pGreater);
+ Names.AddSystemName(lessEqName, 'LessEq', pLessEq);
+ Names.AddSystemName(grEqName, 'GrEq', pGrEq);
+ NEW(AGRS.Failure);
+ AGRS.Failure.Init(AGRS.failName);
+
+ Names.AddSystemName(addName, 'Add', pAdd);
+ Names.AddSystemName(subName, 'Sub', pSub);
+ Names.AddSystemName(mulName, 'Mul', pMul);
+ Names.AddSystemName(divName, 'Div', pDiv);
+ Names.AddSystemName(modName, 'Mod', pMod);
+ Names.AddSystemName(findName, 'Find', pFind);
+ Names.AddSystemName(abortName, 'Abort', pAbort);
+
+ NEW(NamesTerm);
+ NamesTerm.Init(Names.SystemRoot);
+ Names.DefinePublicName(namesName,'Names',NamesTerm);
+END Library.