Category : Modula II Source Code
Archive   : PATTERN.ZIP
Filename : NFAPATTE.MOD

 
Output of file : NFAPATTE.MOD contained in archive : PATTERN.ZIP
IMPLEMENTATION MODULE NFAPattern;
FROM FAInput IMPORT DeterminePosition,NextChar,Position,ReturnLexeme,
SetPosition;
FROM RTSMain IMPORT Status,Terminate;
FROM Terminal IMPORT WriteLn,WriteString;

IMPORT ASCII,FAInput,FileSystem,SYSTEM;

CONST
maxExpr = 4095;


VAR
lastAccept : CARDINAL;
lastPos : Position;

MODULE StateSetHandler;
IMPORT maxExpr;

EXPORT AddToStateMap,AddToStateSet,ClearStateMap,InitializeStateSet,
InStateMap,NullStateSet,ReturnFromStateSet,StateMap,StateSet;

TYPE
StateMap = ARRAY [0..maxExpr DIV 16] OF BITSET;

StateSet = RECORD
info : ARRAY [1..1024] OF CARDINAL;
top : CARDINAL;
END; (* StateSet *)

PROCEDURE AddToStateMap (VAR map : StateMap; state : CARDINAL);
BEGIN (* AddToStateMap *)
INCL (map [state DIV 16],state MOD 16);
END AddToStateMap;

PROCEDURE AddToStateSet (VAR states : StateSet; state : CARDINAL);
BEGIN (* AddToStateSet *)
WITH states DO
INC (top);

info [top] := state;
END; (* WITH *)
END AddToStateSet;

PROCEDURE ClearStateMap (VAR map : StateMap);
VAR
index : CARDINAL;

BEGIN (* ClearStateMap *)
FOR index := 0 TO maxExpr DIV 16 DO
map [index] := {};
END; (* FOR *)
END ClearStateMap;

PROCEDURE InitializeStateSet (VAR states : StateSet);
BEGIN (* InitializeStateSet *)
states.top := 0;
END InitializeStateSet;

PROCEDURE InStateMap (VAR map : StateMap; state : CARDINAL) : BOOLEAN;
BEGIN (* InStateMap *)
RETURN ((state MOD 16) IN map [state DIV 16]);
END InStateMap;

PROCEDURE NullStateSet (VAR states : StateSet) : BOOLEAN;
BEGIN (* NullStateSet *)
RETURN (states.top = 0);
END NullStateSet;

PROCEDURE ReturnFromStateSet (VAR states : StateSet; VAR state : CARDINAL);
BEGIN (* ReturnFromStateSet *)
WITH states DO
state := info [top];

DEC (top);
END; (* WITH *)
END ReturnFromStateSet;
END StateSetHandler;

MODULE NFAHandler;
FROM FAInput IMPORT DeterminePosition;
FROM FileSystem IMPORT File,ReadByte,ReadWord,Response;

FROM StateSetHandler IMPORT AddToStateMap,AddToStateSet,ClearStateMap,
InitializeStateSet,InStateMap,NullStateSet,
ReturnFromStateSet,StateMap,StateSet;

IMPORT AcceptingMarker,EmptyTransition,EndMarker,InvalidMarker,lastAccept,
lastPos,maxExpr,StateRecord;

EXPORT ComputeEClosure,ComputeMove,DefineConstant,DefineState,InitializeNFA,
InitializeStartStates,PatternWithAcceptingState,ReadNFAFromDisk;

CONST
maxConst = 511;

TYPE
ConstRecord = RECORD
acceptingState,constNum,startState : CARDINAL;
END; (* ConstRecord *)

VAR
lastConst,lastExpr : CARDINAL;
initializedStart : BOOLEAN;
startStates : StateSet;
const : ARRAY [0..maxConst] OF ConstRecord;
expr : ARRAY [0..maxExpr] OF StateRecord;

PROCEDURE ComputeEClosure (VAR states : StateSet);
VAR
accepting : BOOLEAN;
state : CARDINAL;
temp : StateSet;
map : StateMap;

BEGIN (* ComputeEClosure *)
InitializeStateSet (temp);
ClearStateMap (map);

accepting := FALSE;

WHILE NOT (NullStateSet (states)) DO
ReturnFromStateSet (states,state);

WITH expr [state] DO
IF char = EmptyTransition THEN
IF next1 = AcceptingMarker THEN
IF (NOT (accepting) OR (state < lastAccept)) THEN
DeterminePosition (lastPos);

lastAccept := state;
accepting := TRUE;
END; (* IF *)
ELSE
IF NOT (InStateMap (map,next1)) THEN
AddToStateMap (map,next1);

IF expr [next1].char <> EmptyTransition THEN
AddToStateSet (temp,next1);
ELSE
AddToStateSet (states,next1);
END; (* IF *)
END; (* IF *)

IF ((next2 <> InvalidMarker) AND (NOT (InStateMap (map,next2)))) THEN
AddToStateMap (map,next2);

IF expr [next2].char <> EmptyTransition THEN
AddToStateSet (temp,next2);
ELSE
AddToStateSet (states,next2);
END; (* IF *)
END; (* IF *)
END; (* IF *)
ELSE
AddToStateSet (temp,state);
END; (* IF *)
END; (* WITH *)
END; (* WHILE *)

states := temp;
END ComputeEClosure;

PROCEDURE ComputeMove (start : StateSet; VAR new : StateSet; ch : CHAR);
VAR
state : CARDINAL;

BEGIN (* ComputeMove *)
InitializeStateSet (new);

WHILE NOT (NullStateSet (start)) DO
ReturnFromStateSet (start,state);

WITH expr [state] DO
IF char = ch THEN
AddToStateSet (new,expr [state].next1);
END; (* IF *)
END; (* WITH *)
END; (* WHILE *)
END ComputeMove;

PROCEDURE DefineConstant (num,start : CARDINAL);
PROCEDURE AcceptingState (start : CARDINAL) : CARDINAL;
VAR
index : CARDINAL;

BEGIN (* AcceptingState *)
index := start;

WHILE expr [index].next1 <> AcceptingMarker DO
index := expr [index].next1;
END; (* WHILE *)

RETURN (index);
END AcceptingState;

BEGIN (* DefineConstant *)
WITH const [lastConst] DO
acceptingState := AcceptingState (start);
startState := start;
constNum := num;
END; (* WITH *)

INC (lastConst);
END DefineConstant;

PROCEDURE DefineState (num,n1,n2 : CARDINAL; ch : CHAR);
BEGIN (* DefineState *)
WITH expr [num] DO
next1 := n1;
next2 := n2;
char := ch;
END; (* WITH *)
END DefineState;

PROCEDURE InitializeNFA;
BEGIN (* InitializeNFA *)
initializedStart := FALSE;
lastConst := 0;
lastExpr := 0;
END InitializeNFA;

PROCEDURE InitializeStartStates (VAR states : StateSet);
VAR
index : CARDINAL;

BEGIN (* InitializeStartStates *)
IF NOT (initializedStart) THEN
initializedStart := TRUE;

InitializeStateSet (startStates);

IF lastConst > 0 THEN
FOR index := 0 TO lastConst - 1 DO
AddToStateSet (startStates,const [index].startState);
END; (* FOR *)

ComputeEClosure (startStates);
END; (* IF *)
END; (* IF *)

states := startStates;
END InitializeStartStates;

PROCEDURE PatternWithAcceptingState (accept : CARDINAL) : CARDINAL;
VAR
index : CARDINAL;

BEGIN (* PatternWithAcceptingState *)
IF lastConst > 0 THEN
FOR index := 0 TO lastConst - 1 DO
WITH const [index] DO
IF accept = acceptingState THEN
RETURN (constNum);
END; (* IF *)
END; (* WITH *)
END; (* FOR *)
END; (* IF *)

RETURN (MAX (CARDINAL));
END PatternWithAcceptingState;

PROCEDURE ReadNFAFromDisk (VAR f : File);
VAR
constNum,num,start : CARDINAL;
tempExpr : ARRAY [0..1023] OF StateRecord;

PROCEDURE ReadExpression (VAR f : File; VAR start,num : CARDINAL; VAR expr : ARRAY OF StateRecord);
VAR
index : CARDINAL;

PROCEDURE ReadState (VAR f : File; VAR state : StateRecord);
BEGIN (* ReadState *)
WITH state DO
ReadWord (f,next1);
ReadWord (f,next2);
ReadByte (f,char);
END; (* WITH *)
END ReadState;

BEGIN (* ReadExpression *)
ReadWord (f,start);
ReadWord (f,num);

FOR index := 0 TO num - 1 DO
ReadState (f,expr [index]);
END; (* FOR *)
END ReadExpression;

PROCEDURE TransExpression (const,start,num : CARDINAL; VAR expr : ARRAY OF StateRecord);
VAR
index,offset : CARDINAL;

BEGIN (* TransExpression *)
offset := lastExpr;

FOR index := 0 TO num - 1 DO
WITH expr [index] DO
IF next1 = AcceptingMarker THEN
DefineState (lastExpr,AcceptingMarker,InvalidMarker,EmptyTransition);
ELSIF next2 = InvalidMarker THEN
DefineState (lastExpr,next1 + offset,InvalidMarker,char);
ELSE
DefineState (lastExpr,next1 + offset,next2 + offset,char);
END; (* IF *)
END; (* WITH *)

INC (lastExpr);
END; (* FOR *)

DefineConstant (const,start + offset);
END TransExpression;

BEGIN (* ReadNFAFromDisk *)
InitializeNFA;

LOOP
ReadWord (f,constNum);

IF ((f.res <> done) OR (constNum = EndMarker)) THEN
EXIT;
END; (* IF *)

ReadExpression (f,start,num,tempExpr);
TransExpression (constNum,start,num,tempExpr);
END; (* LOOP *)
END ReadNFAFromDisk;

BEGIN (* NFAHandler *)
InitializeNFA;
END NFAHandler;

PROCEDURE ReadPattern (VAR num : CARDINAL);
VAR
startPos : Position;
states : StateSet;

BEGIN (* ReadPattern *)
lastAccept := MAX (CARDINAL);

InitializeStartStates (states);
DeterminePosition (startPos);

LOOP
ComputeMove (states,states,NextChar ());

IF NullStateSet (states) THEN
EXIT;
END; (* IF *)

ComputeEClosure (states);
END; (* LOOP *)

num := PatternWithAcceptingState (lastAccept);

IF num = MAX (CARDINAL) THEN
DeterminePosition (lastPos);
END; (* IF *)

ReturnLexeme (startPos,lastPos,lastLexeme);
SetPosition (lastPos);
END ReadPattern;
END NFAPattern.


  3 Responses to “Category : Modula II Source Code
Archive   : PATTERN.ZIP
Filename : NFAPATTE.MOD

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/