(******************************************************************************) (* imports parser *) (* (C) 2011..2012 Steffen Solyga *) (******************************************************************************) IMPLEMENTATION MODULE Prsr; IMPORT FIO; IMPORT Scnr; CONST out = FIO.StandardOutput; err = FIO.ErrorOutput; maxMods = 256; maxNodes = 2048; TYPE TModIdx = [ 0 .. maxMods - 1 ]; TNodeIdx = [ 0 .. maxNodes - 1 ]; TNodes = RECORD n: CARDINAL; a: ARRAY TNodeIdx OF TModIdx; END; TModDesc = RECORD v: Scnr.TValue; n: CARDINAL; j: TNodeIdx; END; TModules = RECORD n: CARDINAL; a: ARRAY TModIdx OF TModDesc; END; TActIdx = [ 0 .. maxMods - 1 ]; TActivations = RECORD n: CARDINAL; a: ARRAY TActIdx OF TModIdx; END; VAR mods: TModules; nodes: TNodes; val: Scnr.TValue; idx: CARDINAL; loop: BOOLEAN; acts: TActivations; PROCEDURE Err( s: ARRAY OF CHAR ); CONST f = err; BEGIN FIO.WrStr( f, 'Prsr.Error: ' ); IF Scnr.ptl > 0 THEN FIO.WrStr( f, Scnr.pth ); FIO.WrStr( f, ' (' ); FIO.WrCard( f, Scnr.pos.l, 0 ); FIO.WrChar( f, ',' ); FIO.WrCard( f, Scnr.pos.c, 0 ); FIO.WrStr( f, '): ' ); ELSIF Scnr.mdl > 0 THEN FIO.WrStr( f, Scnr.mod ); FIO.WrStr( f, ': ' ); END; FIO.WrStr( f, s ); FIO.WrStr( f, '.' ); FIO.WrLn( f ); HALT; END Err; PROCEDURE Warn( s: ARRAY OF CHAR ); CONST f = err; BEGIN FIO.WrStr( f, 'Prsr.Warning: ' ); IF Scnr.mdl > 0 THEN FIO.WrStr( f, Scnr.mod ); FIO.WrStr( f, ': ' ); END; FIO.WrStr( f, s ); FIO.WrStr( f, '.' ); FIO.WrLn( f ); END Warn; PROCEDURE WrModStr( f: FIO.File; i: TModIdx ); VAR l: CARDINAL; s: Scnr.TModName; BEGIN l := Scnr.MkStr( s, mods.a[i].v ); FIO.WrStr( f, s ); END WrModStr; PROCEDURE Show(); CONST f = out; VAR i,j,n: CARDINAL; BEGIN i := 0; WHILE i < mods.n DO WrModStr( f, i ); FIO.WrStr( f, ': ' ); j := mods.a[i].j; n := mods.a[i].n; WHILE n > 0 DO WrModStr( f, nodes.a[j] ); FIO.WrStr( f, ' ' ); INC( j ); DEC( n ); END; FIO.WrLn( f ); INC( i ); END; END Show; PROCEDURE List(); CONST f = out; VAR i: CARDINAL; BEGIN FIO.WrCard( f, acts.n, 0 ); FIO.WrStr( f, ' modules: ' ); i := 0; WHILE i < acts.n DO WrModStr( f, acts.a[i] ); FIO.WrChar( f, ' ' ); INC( i ); END; FIO.WrLn( f ); END List; PROCEDURE Check(); TYPE TLevel = [ 0 .. maxMods ]; TValidLevel = [ 1 .. MAX(TLevel) ]; TModInf = RECORD l: TLevel; a: BOOLEAN; END; VAR lvl : TLevel; infs: ARRAY TModIdx OF TModInf; idxs: ARRAY TValidLevel OF TModIdx; PROCEDURE Init(); VAR i: TModIdx; BEGIN loop := FALSE; acts.n := 0; lvl := 0; FOR i := MIN(TModIdx) TO MAX(TModIdx) DO infs[i].l := 0; infs[i].a := FALSE; END; END Init; PROCEDURE Trace( l1: TLevel ); CONST f = err; VAR l: TValidLevel; BEGIN loop := TRUE; IF l1 > lvl THEN Err( 'Bug: Trace: Invalid level' ) END; FIO.WrStr( f, 'Prsr.Check: ' ); IF l1 > MIN(TValidLevel) THEN FIO.WrStr( f, '( ' ) END; FOR l := MIN(TValidLevel) TO lvl DO IF ( l = l1 ) & ( l1 > MIN(TValidLevel) ) THEN FIO.WrStr( f, ') ' ) END; WrModStr( f, idxs[l] ); FIO.WrStr( f, ' ' ); END; WrModStr( f, idxs[l1] ); FIO.WrLn( f ); END Trace; PROCEDURE Act( mod: TModIdx ); CONST f = err; BEGIN IF infs[mod].a THEN RETURN END; IF acts.n > MAX(TActIdx) THEN Err( 'Bug: Act: Too many modules' ) END; acts.a[acts.n] := mod; INC( acts.n ); infs[mod].a := TRUE; END Act; PROCEDURE Visit( i: TModIdx ); PROCEDURE Enter(); BEGIN INC( lvl ); idxs[lvl] := i; infs[i].l := lvl; END Enter; PROCEDURE Leave(); BEGIN infs[i].l := 0; DEC( lvl ); END Leave; VAR j, n: CARDINAL; BEGIN IF i >= mods.n THEN Err( 'Bug: Visit: Invalid module index' ) END; IF infs[i].l > 0 THEN Trace( infs[i].l ); RETURN END; IF infs[i].a THEN RETURN END; Enter(); j := mods.a[i].j; n := mods.a[i].n; WHILE n > 0 DO Visit( nodes.a[j] ); INC( j ); DEC( n ); END; Leave(); Act( i ); END Visit; BEGIN Init(); Visit( 0 ); END Check; PROCEDURE AddMod(): TModIdx; VAR i: CARDINAL; BEGIN i := 0; WHILE i < mods.n DO IF Scnr.Diff( mods.a[i].v, Scnr.val ) = 0 THEN RETURN i END; INC( i ); END; IF i > MAX(TModIdx) THEN Err( 'Too many modules' ) END; mods.a[i].v := Scnr.val; mods.a[i].n := 0; mods.a[i].j := 0; INC( mods.n ); Scnr.Keep(); RETURN i; END AddMod; PROCEDURE AddNode(); VAR i: TModIdx; j: CARDINAL; BEGIN i := AddMod(); j := mods.a[idx].j; WHILE j < nodes.n DO IF nodes.a[j] = i THEN RETURN END; INC( j ); END; IF j > MAX(TNodeIdx) THEN Err( 'Too many nodes' ) END; nodes.a[j] := i; INC( mods.a[idx].n ); INC( nodes.n ); END AddNode; PROCEDURE Import(); BEGIN IF Scnr.sym = Scnr.sFrom THEN Scnr.Read(); IF Scnr.sym # Scnr.sId THEN Err( 'Expected identifier' ) END; AddNode(); Scnr.Read(); IF Scnr.sym # Scnr.sImport THEN Err( 'Expected "IMPORT"' ) END; Scnr.Read(); IF Scnr.sym # Scnr.sId THEN Err( 'Expected identifier' ) END; Scnr.Read(); WHILE Scnr.sym = Scnr.sComma DO Scnr.Read(); IF Scnr.sym # Scnr.sId THEN Err( 'Expected identifier' ) END; Scnr.Read(); END; ELSE Scnr.Read(); IF Scnr.sym # Scnr.sId THEN Err( 'Expected identifier' ) END; AddNode(); Scnr.Read(); WHILE Scnr.sym = Scnr.sComma DO Scnr.Read(); IF Scnr.sym # Scnr.sId THEN Err( 'Expected identifier' ) END; AddNode(); Scnr.Read(); END; END; IF Scnr.sym # Scnr.sSemi THEN Err( 'Expected ";"' ) END; Scnr.Read(); END Import; PROCEDURE DefinitionModule(); BEGIN Scnr.Read(); IF Scnr.sym # Scnr.sMod THEN Err( 'Expected "MODULE"' ) END; Scnr.Read(); IF Scnr.sym # Scnr.sId THEN Err( 'Expected identifier' ) END; IF Scnr.Diff(Scnr.val,val) # 0 THEN Err( 'Wrong module name' ) END; Scnr.Read(); IF Scnr.sym # Scnr.sSemi THEN Err( 'Expected ";"' ) END; Scnr.Read(); WHILE ( Scnr.sym = Scnr.sFrom ) OR ( Scnr.sym = Scnr.sImport ) DO Import(); END; END DefinitionModule; PROCEDURE Priority(); BEGIN Scnr.Read(); IF Scnr.sym # Scnr.sNum THEN Err( 'Expected number' ) END; Scnr.Read(); IF Scnr.sym # Scnr.sRBrk THEN Err( 'Expected "]"' ) END; Scnr.Read(); END Priority; PROCEDURE ProgramModule(); BEGIN Scnr.Read(); IF Scnr.sym # Scnr.sId THEN Err( 'Expected identifier' ) END; IF Scnr.Diff(Scnr.val,val) # 0 THEN Err( 'Wrong module name' ) END; Scnr.Read(); IF Scnr.sym = Scnr.sLBrk THEN Priority() END; IF Scnr.sym # Scnr.sSemi THEN Err( 'Expected ";"' ) END; Scnr.Read(); WHILE ( Scnr.sym = Scnr.sFrom ) OR ( Scnr.sym = Scnr.sImport ) DO Import(); END; END ProgramModule; PROCEDURE ImplementationModule(); BEGIN Scnr.Read(); IF Scnr.sym # Scnr.sMod THEN Err( 'Expected "MODULE"' ) END; ProgramModule(); END ImplementationModule; PROCEDURE Inspect( str: ARRAY OF CHAR; flgs: TFlags ); VAR req, res: TFlags; BEGIN (* Warn( 'Building...' ); *) Scnr.Put( str ); idx := AddMod(); WHILE idx < mods.n DO val := mods.a[idx].v; mods.a[idx].n := 0; IF nodes.n > MAX(TNodeIdx) THEN Err( 'Too many nodes' ) END; mods.a[idx].j := nodes.n; req := flgs; res := TFlags{}; IF ( fDef IN req ) & ( Scnr.Open( val, TRUE ) ) THEN Scnr.Read(); IF Scnr.sym = Scnr.sDef THEN DefinitionModule(); ELSIF Scnr.sym = Scnr.sFrgn THEN DefinitionModule(); EXCL( req, fMod ); ELSE Err( 'Expected "DEFINITION" or "FOREIGN"' ); END; INCL( res, fDef ); END; IF ( fMod IN req ) & ( Scnr.Open( val, FALSE ) ) THEN Scnr.Read(); IF Scnr.sym = Scnr.sImpl THEN ImplementationModule(); ELSIF ( Scnr.sym = Scnr.sMod ) & ( idx = 0 ) THEN ProgramModule(); IF fDef IN res THEN Err( 'Definition module exists' ) END; EXCL( req, fDef ); ELSE Err( 'Expected "IMPLEMENTATION"' ); END; INCL( res, fMod ); END; IF res = fsNone THEN IF idx = 0 THEN Err( 'Module not found' ) END; ELSIF res # req THEN IF ~ ( fDef IN res ) THEN Warn( 'Missing definition module' ) END; IF ~ ( fMod IN res ) THEN Warn( 'Missing implementation module' ) END; END; Scnr.Close(); INC( idx ); END; (* Warn( 'Checking...' ); *) Check(); (* Warn( 'Listing...' ); *) List(); (* Warn( 'Showing...' ); Show(); *) END Inspect; BEGIN mods.n := 0; nodes.n := 0; val := Scnr.val; idx := 0; loop := FALSE; acts.n := 0; END Prsr.