Copyright (C) 1994, Digital Equipment Corp.
MODULE ObFrame;
IMPORT ObErr, SynWr, SynScan, Rd, TextRd, Lex, FileRd, Text, OSError, Pathname, ObLib, ObValue, SynLocation, ObEval;
IMPORT Env AS ProcessEnv;
PROCEDURE FmtSearchPath(searchPath: SearchPath): TEXT =
BEGIN
IF searchPath=NIL THEN RETURN "";
ELSIF searchPath.rest=NIL THEN RETURN searchPath.first;
ELSE RETURN
searchPath.first &
Text.FromChar(SearchPathSeparator) &
FmtSearchPath(searchPath.rest);
END;
END FmtSearchPath;
PROCEDURE LexSearchPath(rd: TextRd.T): SearchPath =
VAR item, junk: TEXT; rest: SearchPath;
BEGIN
IF Rd.EOF(rd) <* NOWARN *> THEN RETURN NIL
ELSE
junk :=
Lex.Scan(rd, <* NOWARN *>
Lex.Blanks + SET OF CHAR{SearchPathSeparator}); <* NOWARN *>
item :=
Lex.Scan(rd, <* NOWARN *>
Lex.NonBlanks - SET OF CHAR{SearchPathSeparator}); <* NOWARN *>
IF Text.Empty(junk) AND Text.Empty(item) THEN RETURN NIL END;
rest := LexSearchPath(rd);
IF Text.Empty(item) THEN RETURN rest;
ELSIF NOT Pathname.Valid(item) THEN RETURN rest;
ELSE RETURN NEW(SearchPath, first:=item, rest:=rest);
END;
END;
END LexSearchPath;
PROCEDURE PostFile(sc: SynScan.T; filename: Pathname.T): BOOLEAN =
VAR rd: Rd.T;
BEGIN
TRY
rd:= FileRd.Open(filename);
SynWr.Text(SynWr.out, "Loading '" & filename & "'\n");
SynScan.PushInput(sc, Pathname.Last(filename), rd, TRUE, TRUE);
RETURN TRUE;
EXCEPT OSError.E => RETURN FALSE
END;
END PostFile;
PROCEDURE LoadFile(sc: SynScan.T; filename: Pathname.T;
complain: BOOLEAN:=TRUE) RAISES {ObErr.Fail} =
VAR scan: SearchPath;
BEGIN
IF Pathname.Valid(filename) THEN
IF Pathname.Absolute(filename) THEN
IF PostFile(sc, filename) THEN RETURN END;
ELSE
scan := searchPath;
WHILE scan # NIL DO
IF PostFile(sc,
Pathname.Join(scan.first, filename, NIL))
THEN RETURN
END;
scan := scan.rest;
END;
END;
END;
IF complain THEN
SynScan.ErrorMsg(sc, "Could not open file '" & filename
& "' along path '" & FmtSearchPath(searchPath) & "'");
END;
END LoadFile;
PROCEDURE ModuleFrame(sc: SynScan.T; name, for: TEXT;
imports: NameList; env: Env) RAISES {ObErr.Fail} =
Push scanner inputs so it will first load the imports first
to last, then establish a frame for this module, and then
finish reading this module. The last PushInput is executed first.
BEGIN
SynScan.PushInput(sc, "<none>",
TextRd.New("establish " & name & " for " & for & ";\n"),
TRUE, TRUE);
LoadImports(sc, imports, env);
END ModuleFrame;
PROCEDURE ModuleEnd(sc: SynScan.T) RAISES {ObErr.Fail} =
BEGIN
SynScan.PushInput(sc, "<none>", TextRd.New("qualify;\n"), TRUE, TRUE);
END ModuleEnd;
PROCEDURE LoadImports(sc: SynScan.T; imports: NameList; env: Env)
RAISES {ObErr.Fail} =
last to first, so the scanner will see them first to last
BEGIN
IF imports#NIL THEN
LoadImports(sc, imports.rest, env);
ImportFrame(sc, imports.first, env);
END;
END LoadImports;
PROCEDURE ImportFrame(sc: SynScan.T; name: TEXT; env: Env)
RAISES {ObErr.Fail} =
VAR scan: Env;
BEGIN
scan:=FindFrame(name, env);
IF scan=NIL THEN LoadFile(sc, name & ".obl");
ELSIF SynScan.TopLevel(sc) THEN
SynWr.Text(SynWr.out, "(Frame '" & name &
"' already exists and has not been reloaded)\n");
END;
END ImportFrame;
PROCEDURE ModAndLib(name, for: TEXT): TEXT =
BEGIN
IF Text.Equal(name, for) THEN RETURN "'" & name & "'"
ELSE RETURN "'" & name & "' for '" & for & "'" END;
END ModAndLib;
PROCEDURE EstablishFrame(name, for: TEXT; env: Env): Env
RAISES {ObErr.Fail} =
VAR moduleExists, frameExists: BOOLEAN;
BEGIN
SynWr.Text(SynWr.out, "Establishing " & ModAndLib(name,for) & "\n");
moduleExists := ObLib.Lookup(name, env.libEnv)#NIL;
frameExists := FindFrame(name, env)#NIL;
IF frameExists THEN
RETURN SaveFrame(name, for, DeleteFrame(name, env));
ELSIF moduleExists THEN
ObErr.Fault(SynWr.out,
"Module name conflicts with existing library: '" & name & "_'");
ELSE
RETURN SaveFrame(name, for, env);
END;
END EstablishFrame;
PROCEDURE SaveFrame(name, for: TEXT; env: Env): Env
RAISES {ObErr.Fail} =
VAR scan: Env;
BEGIN
scan:=FindFrame(name, env);
IF scan#NIL THEN
ObErr.Fault(SynWr.out, "Frame already exists: '" & name & "'");
RETURN env;
END;
IF NOT Text.Empty(name) THEN
SynWr.Text(SynWr.out, "(Created frame " & ModAndLib(name,for) & ")\n");
END;
RETURN
NEW(Env,
frameName := name,
forName := for,
libEnv := env.libEnv,
scopeEnv := env.scopeEnv,
checkEnv := env.checkEnv,
valueEnv := env.valueEnv,
nextFrame := env);
END SaveFrame;
PROCEDURE DeleteFrame(name: TEXT; env: Env): Env RAISES {ObErr.Fail} =
VAR scan: Env;
BEGIN
scan:=FindFrame(name, env);
IF scan=NIL THEN
RETURN env;
ELSE
LOOP
SynWr.Text(SynWr.out,
"(Deleted frame " & ModAndLib(env.frameName,env.forName) & ")\n");
IF env=scan THEN EXIT END;
env:=env.nextFrame;
END;
RETURN scan.nextFrame;
END;
END DeleteFrame;
PROCEDURE FindFrame(name: TEXT; env: Env): Env =
VAR scan: Env;
BEGIN
scan:=env;
LOOP
IF scan=NIL THEN EXIT END;
IF Text.Equal(scan.frameName, name) THEN EXIT END;
scan := scan.nextFrame;
END;
RETURN scan;
END FindFrame;
TYPE
FrameLib =
ObLib.T OBJECT
OVERRIDES
Eval := FrameLibEval;
END;
PROCEDURE QualifyFrame(env: Env): Env
RAISES {ObErr.Fail} =
VAR scanValueEnv: ObValue.Env;
frameSize: INTEGER; opCodes: REF ObLib.OpCodes;
library: ObLib.T; newLibEnv: ObLib.Env; newEnv: Env;
BEGIN
IF Text.Empty(env.frameName) THEN RETURN env END;
scanValueEnv := env.valueEnv;
frameSize := 0;
LOOP
IF scanValueEnv=env.nextFrame.valueEnv THEN EXIT END;
INC(frameSize);
scanValueEnv:=scanValueEnv.rest;
END;
opCodes := NEW(REF ObLib.OpCodes, frameSize);
scanValueEnv := env.valueEnv;
FOR i:=0 TO frameSize-1 DO
opCodes[i] :=
NEW(FrameOpCode, name:=scanValueEnv.name.text,
arity := -2, fixity := ObLib.OpFixity.Qualified,
val := NARROW(scanValueEnv, ObValue.LocalEnv).val);
scanValueEnv:=scanValueEnv.rest;
END;
library := NEW(FrameLib, name:=env.forName, opCodes:=opCodes);
newLibEnv := ObLib.Extend(library, env.libEnv);
newEnv :=
NEW(Env,
frameName := env.frameName,
forName := env.forName,
libEnv := newLibEnv,
scopeEnv := env.nextFrame.scopeEnv,
checkEnv := env.nextFrame.checkEnv,
valueEnv := env.nextFrame.valueEnv,
nextFrame := env.nextFrame);
SynWr.Text(SynWr.out,
"(Closed frame " & ModAndLib(env.frameName,env.forName) & ")\n");
RETURN newEnv;
END QualifyFrame;
PROCEDURE FrameLibEval(self: FrameLib; opCode: ObLib.OpCode;
arity: ObLib.OpArity; READONLY args: ObValue.ArgArray;
temp: BOOLEAN; loc: SynLocation.T)
: ObValue.Val RAISES {ObValue.Error, ObValue.Exception} =
VAR frameOpCode: FrameOpCode;
BEGIN
frameOpCode := NARROW(opCode, FrameOpCode);
IF arity = -1 THEN
RETURN frameOpCode.val;
ELSIF arity > NUMBER(args) THEN
ObValue.RaiseError("Too many arguments", loc);
ELSE
RETURN ObEval.Call(frameOpCode.val, SUBARRAY(args, 0, arity), loc);
END;
END FrameLibEval;
PROCEDURE Setup() =
VAR envPath: TEXT;
BEGIN
envPath := ProcessEnv.Get("OBLIQPATH");
IF envPath=NIL THEN
searchPath :=
NEW(SearchPath,
first:=Pathname.Current,
rest:= NIL);
ELSE
searchPath := LexSearchPath(TextRd.New(envPath));
END;
END Setup;
BEGIN
END ObFrame.