[ivy]<Satterthwaite>SML>SMIntImpl.mesa!10

SMIntImpl.mesa

last edit by Satterthwaite, May 29, 1986 12:00:08 pm PDT

DIRECTORY

BasicTime: TYPE USING [GMT, nullGMT],

Buttons: TYPE USING [Button, ButtonProc],

Commander: TYPE USING [CommandProc, Register],

Containers: TYPE USING [ChildXBound, ChildYBound, Container, Create],

CS: TYPE USING [EndsIn, GMTFromRope, Init, RootName, RopeFromGMT, ShortName],

FS: TYPE USING [

OpenFile, nullOpenFile,

Create, Error, FileInfo, GetInfo, GetName, Open, StreamFromOpenFile],

IO: TYPE USING [card, Close, PutChar, PutF, PutFR, PutRope, RIS, rope, STREAM, time],

Labels: TYPE USING [Create, Label, Set, SetDisplayStyle],

List: TYPE USING [DRemove],

MBQueue: TYPE USING [Create, CreateMenuEntry, CreateButton, Flush, Queue],

Menus: TYPE USING [CreateEntry, CreateMenu, InsertMenuEntry, Menu, MenuProc],

Process: TYPE USING [Abort, CheckForAbort, GetCurrent],

ProcessProps: TYPE USING [GetProp],

Rope: TYPE USING [Concat, Equal, Find, Flatten, IsEmpty, Length, ROPE, Substr, Text],

Rules: TYPE USING [Create, Rule],

SMBcd: TYPE USING [WriteModelBcd],

SMComp: TYPE USING [CompileAll, LoadCompiler],

SMDF: TYPE USING [WriteDFFile],

SMEval: TYPE USING [Equiv, Eval],

SMFI: TYPE USING [SrcFileInfo],

SMFIOps: TYPE USING [

Ambiguous, EvaluateUnitId, Reset, NewestBcd, NewestSource, UnitToRope],

SMLDriver: TYPE USING [Bind, LoadAndBind, Loaded, StartAll, Started, Unload],

SMOps: TYPE USING [MS, NewModel, PatchList],

SMProj: TYPE USING [Proj, Reset],

SMUtil: TYPE USING [ParseStream, PrettyPrint, PrintTree],

SMTree: TYPE Tree USING [Ext, Handle, Link, null],

SMTreeOps: TYPE TreeOps USING [

GetExt, Initialize, Finalize, Map, NthSon, OpName, PutExt, PutNthSon,

Scan, ScanSons, UpdateLeaves],

TiogaMenuOps: TYPE USING [Open],

TypeScript: TYPE USING [TS, Create],

ViewerClasses: TYPE USING [Viewer],

ViewerEvents: TYPE USING [

EventProc, EventRegistration, RegisterEventProc, UnRegisterEventProc],

ViewerIO: TYPE USING [CreateViewerStreams],

ViewerOps: TYPE USING [

AddProp, EstablishViewerPosition, FetchProp, PaintViewer, SetMenu, SetOpenHeight],

ViewerTools: TYPE USING [

EnableUserEdits, GetContents, GetSelectionContents, InhibitUserEdits, MakeNewTextViewer,

SetContents, SetSelection];

SMIntImpl: CEDAR PROGRAM

IMPORTS

Commander, Containers, CS, FS, MBQueue, IO, Labels, List, Menus,

Process, ProcessProps, Rope, Rules,

SMBcd, SMComp, SMDF, SMEval, SMFIOps, SMLDriver, SMOps, SMProj, SMUtil, SMTreeOps,

TiogaMenuOps, TypeScript, ViewerEvents, ViewerOps, ViewerIO, ViewerTools ~ {

OPEN Tree~~SMTree, TreeOps~~SMTreeOps;

modeller state

ModelState: TYPE~{ -- ordered

idle, unparsed, parsed, checked, compiled, loaded, run};

global data

Global: TYPE ~ REF GlobalRecord;

GlobalRecord: TYPE ~ RECORD[

viewers data

container: Containers.Container←NIL,

ttyin: IO.STREAM←NIL,

ttyout: IO.STREAM←NIL,

msgout: IO.STREAM←NIL,

viewers fields

modelFileNameButton: Buttons.Button←NIL,

modelFileNameViewer: ViewerClasses.Viewer←NIL,

wDirNameButton: Buttons.Button←NIL,

wDirNameViewer: ViewerClasses.Viewer←NIL,

attachEditorButton: Buttons.Button←NIL,

attachEditorLabel: Labels.Label←NIL,

modelling state

state: ModelState←$idle,

stateLabel: Labels.Label←NIL,

replaceable: BOOL←FALSE,

other objects

process: UNSAFE PROCESS←NIL, -- current menu process (NIL if none)

q: MBQueue.Queue←MBQueue.Create[],

noticeList: LIST OF Rope.Text←NIL, -- files that have been noticed

attachEditor: BOOL←TRUE,

attachEditorRef: REF ANY←NIL,

model: SMOps.MS←NIL, -- non-NIL iff state # $idle

modelFileName: Rope.ROPE←NIL,

modelFileVersion: BasicTime.GMT�sicTime.nullGMT,

wDir: Rope.ROPE←NIL,

modelUpdated: BOOL←FALSE,

modelSuperseded: BOOL←FALSE,

debugLevel: NAT←NAT.LAST -- <= 1: parse tree, <=2: value tree, <= 3: pp value

];

MDS usage

globalList: LIST OF Global ← NIL; -- not properly monitored

destroyEventRegistration: ViewerEvents.EventRegistration;

end of MDS usage

these are commands for the viewers world

entryHeight: NAT ~ 15;

entryVSpace: NAT ~ 7;

entryHSpace: NAT ~ 10;

Create: PROC[wDir: Rope.ROPE] RETURNS[g: Global] ~ {

ttyTypeScript, msgTypeScript: TypeScript.TS;

vName: Rope.ROPE ~ IO.PutFR["Cedar Modeller 6.1a, started on %t", IO.time[]];

menu: Menus.Menu ~ Menus.CreateMenu[lines~3];

QMenuItem: PROC[name: Rope.ROPE, proc: Menus.MenuProc, line: NAT] ~ {

menu.InsertMenuEntry[(g.q).CreateMenuEntry[name, proc, g], line]};

MenuItem: PROC[name: Rope.ROPE, proc: Menus.MenuProc, line: NAT] ~ {

menu.InsertMenuEntry[Menus.CreateEntry[name, proc, g], line]};

g ← NEW[GlobalRecord ← [

container~Containers.Create[

info~[name~vName, iconic~FALSE, scrollable~FALSE, column~$right]]]

];

ViewerOps.AddProp[g.container, $SMGlobalRef, g];

first row of menu items

QMenuItem["Debug", Debug, 0];

QMenuItem["StopModel", StopModel, 0];

QMenuItem["Continue", Continue, 0];

QMenuItem["Begin", Begin, 0];

QMenuItem["NoticeAll", NoticeAll, 0];

QMenuItem["StartModel", StartModel, 0];

second row of menu items

MenuItem["NewModeller", NewModeller, 1];

QMenuItem["Bind", Bind, 1];

QMenuItem["MakeDFFile", MakeDFFile, 1];

QMenuItem["MakeModelBcd", MakeModelBcd, 1];

third row of menu items

MenuItem["Abort", Abort, 2];

QMenuItem["Unload", Unload, 2];

QMenuItem["Start", Start, 2];

QMenuItem["Load", Load, 2];

QMenuItem["Compile", Compile, 2];

QMenuItem["Check", Check, 2];

MenuItem["Open", Open, 2];

ViewerOps.SetMenu[g.container, menu, FALSE];

[ttyTypeScript, msgTypeScript] ← BuildUserInput[g, wDir];

kludge required for multiple rows in menus

ViewerOps.EstablishViewerPosition[

g.container, g.container.wx, g.container.wy, g.container.ww, g.container.wh];

ViewerOps.PaintViewer[g.container, $all];

[in~g.ttyin, out~g.ttyout] ← ViewerIO.CreateViewerStreams[viewer~ttyTypeScript, name~NIL];

g.msgout ← ViewerIO.CreateViewerStreams[viewer~msgTypeScript, name~NIL].out;

IF g.attachEditor THEN AttachSymbiote[g];

globalList ← CONS[g, globalList]};

BuildUserInput: PROC[g: Global, wDir: Rope.ROPE]

RETURNS[ttyTypeScript, msgTypeScript: TypeScript.TS] ~ {

heightSoFar: CARDINAL ← 0;

l: ViewerClasses.Viewer ← NIL;

rule: Rules.Rule;

CreateButton: PROC[bName, lName: Rope.ROPE, newLine: BOOL, drawRule: BOOL←FALSE]

RETURNS[button: Buttons.Button, label: Labels.Label] ~ {

x: CARDINAL;

IF newLine THEN {

heightSoFar ← heightSoFar + entryVSpace/2;

IF drawRule THEN {

rule ← Rules.Create[

info~[parent~g.container, wx~0, wy~heightSoFar, ww~0, wh~1]];

Containers.ChildXBound[g.container, rule];

heightSoFar ← heightSoFar + entryVSpace};

x ← 0}

ELSE x ← l.wx + l.ww + entryHSpace;

l ← button ← (g.q).CreateButton[

info~[name~bName, parent~g.container, border~FALSE, wx~x, wy~heightSoFar],

proc~PushButton,

clientData~g];

IF lName ~= NIL THEN

l ← label ← Labels.Create[info~[

name~lName, parent~g.container,

wx~button.wx+button.ww+entryHSpace, wy~heightSoFar, border~FALSE]];

};

first line

[g.modelFileNameButton, ] ← CreateButton["ModelName:", NIL, TRUE];

l ← g.modelFileNameViewer ← ViewerTools.MakeNewTextViewer[

info~[

parent~g.container,

wx~l.wx+l.ww+entryHSpace, wy~heightSoFar, ww~100, wh~entryHeight,

data~NIL, scrollable~FALSE, border~FALSE],

paint~FALSE];

Containers.ChildXBound[g.container, g.modelFileNameViewer];

heightSoFar ← heightSoFar + l.wh + entryVSpace/2;

second line

[g.wDirNameButton, ] ← CreateButton["Working Directory:", NIL, TRUE];

l ← g.wDirNameViewer ← ViewerTools.MakeNewTextViewer[

info~[

parent~g.container,

wx~l.wx+l.ww+entryHSpace, wy~heightSoFar, ww~100, wh~entryHeight,

data~NIL, scrollable~FALSE, border~FALSE],

paint~FALSE];

Containers.ChildXBound[g.container, g.wDirNameViewer];

ViewerTools.SetContents[g.wDirNameViewer, wDir];

heightSoFar ← heightSoFar + l.wh + entryVSpace/2;

third line

heightSoFar ← heightSoFar + entryVSpace/2;

l ← Labels.Create[info~[

name~"State: ", parent~g.container, wx~0, wy~heightSoFar, border~FALSE]];

l ← g.stateLabel ← Labels.Create[info~[

name~"wwwwww",

parent~g.container, wx~l.wx+l.ww+entryHSpace, wy~heightSoFar, border~FALSE]];

SetState[g, $idle];

[g.attachEditorButton, g.attachEditorLabel] ← CreateButton["AttachEditor:", "FALSE", FALSE];

IF g.attachEditor THEN Labels.Set[g.attachEditorLabel, "TRUE"];

heightSoFar ← heightSoFar + l.wh + entryVSpace/2;

first the msg window

now the line above the typescript

rule ← Rules.Create[info~[parent~g.container, wx~0, wy~heightSoFar, ww~0, wh~1]];

Containers.ChildXBound[g.container, rule];

heightSoFar ← heightSoFar + entryVSpace/2;

now the typescript

msgTypeScript ← TypeScript.Create[

info~[parent~g.container, wx~0, wy~heightSoFar, ww~0, wh~25, border~FALSE]];

Containers.ChildXBound[g.container, msgTypeScript];

heightSoFar ← heightSoFar + entryVSpace + 20;

now the line above the typescript

rule ← Rules.Create[info~[parent~g.container, wx~0, wy~heightSoFar, ww~0, wh~1]];

Containers.ChildXBound[g.container, rule];

heightSoFar ← heightSoFar + entryVSpace/2;

now the typescript

ttyTypeScript ← TypeScript.Create[

info~[parent~g.container, wx~0, wy~heightSoFar, ww~0, wh~80, border~FALSE]];

heightSoFar ← heightSoFar + entryVSpace + 80;

Containers.ChildXBound[g.container, ttyTypeScript];

Containers.ChildYBound[g.container, ttyTypeScript];

ViewerOps.SetOpenHeight[g.container, heightSoFar + 200]};

SetState: PROC[g: Global, state: ModelState] ~ {

Labels.SetDisplayStyle[g.stateLabel, $BlackOnWhite];

Labels.Set[g.stateLabel, SELECT state FROM

$idle => "idle",

$unparsed => "unparsed",

$parsed => "parsed",

$checked => "checked",

$compiled => "compiled",

$loaded => "loaded",

$run => "started",

ENDCASE => "ERROR"];

g.state ← state};

PushButton: Buttons.ButtonProc ~ {

g: Global ~ NARROW[clientData];

SELECT NARROW[parent, Buttons.Button] FROM

g.modelFileNameButton =>

ViewerTools.SetSelection[g.modelFileNameViewer, NIL];

g.wDirNameButton =>

ViewerTools.SetSelection[g.wDirNameViewer, NIL];

g.attachEditorButton => {

g.attachEditor ← ~g.attachEditor;

Labels.Set[g.attachEditorLabel, IF g.attachEditor THEN "TRUE" ELSE "FALSE"];

IF g.attachEditor THEN AttachSymbiote[g] ELSE DetachSymbiote[g, TRUE]};

ENDCASE => ERROR;

};

MENU PROCS

Abort: Menus.MenuProc ~ TRUSTED {

not on the queue

g: Global ~ NARROW[clientData];

(g.q).Flush[];

IF g.process # NIL THEN Process.Abort[g.process]}; -- not properly monitored

Begin: Menus.MenuProc ~ {

g: Global ~ NARROW[clientData];

g.process ← Process.GetCurrent[];

{

ENABLE ABORTED => {GOTO out};

InternalUnload[g, TRUE];

IF g.state = $idle OR g.modelSuperseded THEN InternalStartModel[g];

InternalParse[g, TRUE];

IF g.state >= $parsed THEN ClearExtensions[g.model.tree];

InternalCheck[g];

InternalCompile[g, FALSE];

InternalLoad[g, FALSE];

InternalStart[g];

g.process ← NIL;

EXITS

out => {g.ttyout.PutRope["Begin aborted\n"]};

};

SetState[g, g.state]};

Bind: Menus.MenuProc ~ {

g: Global ~ NARROW[clientData];

g.process ← Process.GetCurrent[];

{

ENABLE ABORTED => {GOTO out};

IF g.state = $idle OR g.modelSuperseded THEN InternalStartModel[g];

InternalParse[g, TRUE];

InternalCheck[g];

InternalCompile[g, g.replaceable];

InternalBind[g];

g.process ← NIL;

EXITS

out => {g.ttyout.PutRope["Bind aborted\n"]};

};

SetState[g, g.state]};

Check: Menus.MenuProc ~ {

g: Global ~ NARROW[clientData];

g.process ← Process.GetCurrent[];

{

ENABLE ABORTED => {GOTO out};

IF g.state = $idle OR g.modelSuperseded THEN InternalStartModel[g];

InternalParse[g, TRUE];

InternalCheck[g];

g.process ← NIL;

EXITS

out => {g.ttyout.PutRope["Check aborted\n"]};

};

SetState[g, g.state]};

Compile: Menus.MenuProc ~ {

g: Global ~ NARROW[clientData];

g.process ← Process.GetCurrent[];

{

ENABLE ABORTED => {GOTO out};

IF g.state = $idle OR g.modelSuperseded THEN InternalStartModel[g];

InternalParse[g, TRUE];

InternalCheck[g];

InternalCompile[g, FALSE];

g.process ← NIL;

EXITS

out => {g.ttyout.PutRope["Compile aborted\n"]};

};

SetState[g, g.state]};

Continue: Menus.MenuProc ~ {

g: Global ~ NARROW[clientData];

g.process ← Process.GetCurrent[];

{

ENABLE ABORTED => {GOTO out};

IF g.state = $idle OR g.modelSuperseded THEN InternalStartModel[g];

InternalParse[g, TRUE];

InternalCheck[g];

InternalCompile[g, g.replaceable];

InternalLoad[g, g.replaceable];

InternalStart[g];

g.process ← NIL;

EXITS

out => {g.ttyout.PutRope["Continue aborted\n"]};

};

SetState[g, g.state]};

Debug: Menus.MenuProc ~ {

g: Global ~ NARROW[clientData];

g.ttyout.PutRope["---------------\n"];

IF g.state = $idle THEN {

ENABLE ABORTED => {GOTO out};

g.model ← SMOps.NewModel[g.ttyin, g.ttyout, g.ttyout];

(g.model.tm).Initialize;

g.model.tree ← SMUtil.ParseStream[g.model, IO.RIS[ViewerTools.GetSelectionContents[]]];

IF g.model.tree # Tree.null THEN {

IF g.debugLevel <= 1 THEN SMUtil.PrintTree[g.model, g.model.tree];

SMUtil.PrettyPrint[g.model.out, g.model.tree, g.model.comments]};

IF g.model.tree # Tree.null THEN {

g.model.val ← SMEval.Eval[g.model, g.model.tree, NIL];

g.model.out.PutRope["\n\n"];

SMUtil.PrintTree[g.model, g.model.val];

SMUtil.PrettyPrint[g.model.out, g.model.val, NIL];

g.model.val ← NIL};

g.model ← NIL;

EXITS

out => {g.ttyout.PutRope["Debug aborted\n"]};

};

g.ttyout.PutRope["---------------\n"]};

Load: Menus.MenuProc ~ {

g: Global ~ NARROW[clientData];

g.process ← Process.GetCurrent[];

{

ENABLE ABORTED => {GOTO out};

InternalLoad[g, FALSE];

g.process ← NIL;

EXITS

out => {g.ttyout.PutRope["Load aborted\n"]};

};

SetState[g, g.state]};

MakeDFFile: Menus.MenuProc ~ {

g: Global ~ NARROW[clientData];

g.process ← Process.GetCurrent[];

{

ENABLE ABORTED => {GOTO out};

IF g.state >= $checked THEN {

InternalTemporary[g];

SMDF.WriteDFFile[g.model, g.model.val, g.modelFileName]};

g.process ← NIL;

EXITS

out => {g.ttyout.PutRope["MakeDFFile aborted\n"]};

};

MakeModelBcd: Menus.MenuProc ~ {

g: Global ~ NARROW[clientData];

g.process ← Process.GetCurrent[];

{

ENABLE ABORTED => {GOTO out};

IF g.state >= $checked THEN {

InternalTemporary[g];

SMBcd.WriteModelBcd[g.model, g.model.val, g.modelFileName]};

g.process ← NIL;

EXITS

out => {g.ttyout.PutRope["MakeModelBcd aborted\n"]};

};

NewModeller: Menus.MenuProc ~ {

g: Global ~ NARROW[clientData];

[] ← Create[ViewerTools.GetContents[g.wDirNameViewer]]};

NoticeAll: Menus.MenuProc ~ {

g: Global ~ NARROW[clientData];

g.process ← Process.GetCurrent[];

{

ENABLE ABORTED => {GOTO out};

InternalNoticeAll[g];

g.process ← NIL;

EXITS

out => {g.ttyout.PutRope["NoticeAll aborted\n"]};

};

Open: Menus.MenuProc ~ {

g: Global ~ NARROW[clientData];

g.process ← Process.GetCurrent[];

{

ENABLE ABORTED => {GOTO out};

OpenViewer[g];

g.process ← NIL;

EXITS

out => {g.ttyout.PutRope["Open aborted\n"]};

};

StartModel: Menus.MenuProc ~ {

g: Global ~ NARROW[clientData];

g.process ← Process.GetCurrent[];

{

ENABLE ABORTED => {GOTO out};

InternalStartModel[g];

InternalParse[g];

g.process ← NIL;

EXITS

out => {g.ttyout.PutRope["StartModelling aborted\n"]};

};

SetState[g, g.state]};

Start: Menus.MenuProc ~ {

g: Global ~ NARROW[clientData];

g.process ← Process.GetCurrent[];

{

ENABLE ABORTED => {GOTO out};

InternalStart[g];

g.process ← NIL;

EXITS

out => {g.ttyout.PutRope["Start aborted\n"]};

};

SetState[g, g.state]};

StopModel: Menus.MenuProc ~ {

g: Global ~ NARROW[clientData];

g.process ← Process.GetCurrent[];

{

ENABLE ABORTED => {GOTO out};

InternalStopModel[g];

g.process ← NIL;

EXITS

out => {g.ttyout.PutRope["StopModelling aborted\n"]};

};

SetState[g, $idle]};

Unload: Menus.MenuProc ~ {

g: Global ~ NARROW[clientData];

g.process ← Process.GetCurrent[];

{

ENABLE ABORTED => {GOTO out};

InternalUnload[g, TRUE];

g.process ← NIL;

EXITS

out => {g.ttyout.PutRope["Unload aborted\n"]};

};

SetState[g, g.state]};

SUPPORT ROUTINES

AttachSymbiote: PROC[g: Global] ~ {

IF g.attachEditorRef = NIL THEN

g.attachEditorRef ← ViewerEvents.RegisterEventProc[SaveEvent, $save];

g.msgout.PutRope["Editor set to call this modeller.\n"]};

DetachSymbiote: PROC[g: Global, print: BOOL] ~ {

IF g.attachEditorRef ~= NIL THEN

ViewerEvents.UnRegisterEventProc[g.attachEditorRef, $save];

g.attachEditorRef ← NIL;

IF print THEN g.msgout.PutRope["Editor detached from this modeller.\n"]};

SaveEvent: ViewerEvents.EventProc ~ {

this is the procedure called by the editor

can't print anything in this procedure

ENABLE ANY => {GOTO out};

IF viewer.file # NIL THEN {

tag: Rope.ROPE ~ CS.ShortName[viewer.file];

IF CS.EndsIn[tag, ".mesa"] THEN -- only source now

FOR l: LIST OF Global ← globalList, l.rest UNTIL l = NIL DO

l.first.noticeList ← CONS[tag.Flatten[], l.first.noticeList];

ENDLOOP

ELSE IF CS.EndsIn[tag, ".model"] THEN

FOR l: LIST OF Global ← globalList, l.rest UNTIL l = NIL DO

IF tag.Equal[l.first.modelFileName, FALSE] THEN l.first.modelSuperseded ← TRUE;

ENDLOOP

};

EXITS

out => NULL;

};

DestroyEvent: ViewerEvents.EventProc ~ {

IF event = $destroy AND globalList # NIL THEN {

g: Global ~ NARROW[ViewerOps.FetchProp[viewer, $SMGlobalRef]];

IF g ~= NIL THEN {

DetachSymbiote[g, FALSE];

FOR l: LIST OF Global ← globalList, l.rest UNTIL l = NIL DO

IF l.first.container = viewer THEN TRUSTED {

globalList ← LOOPHOLE[List.DRemove[ref~l.first, list~LOOPHOLE[globalList]]];

EXIT};

ENDLOOP;

IF globalList = NIL THEN {

SMFIOps.Reset[]; SMProj.Reset[];

ViewerEvents.UnRegisterEventProc[destroyEventRegistration, $destroy];

destroyEventRegistration ← NIL}

};

OpenViewer: PROC[g: Global] ~ {

selection: Rope.ROPE ~ ViewerTools.GetSelectionContents[];

index: INT ~ selection.Find[s2~"!"];

name, version: Rope.ROPE;

create: BasicTime.GMT;

{

fName: Rope.ROPE;

IF index = -1 THEN {name ← selection; version ← NIL}

ELSE {

name ← selection.Substr[0, index];

version ← selection.Substr[index+1, selection.Length-index-1]};

IF name.Find[s2~"."] = -1 THEN name ← name.Concat[".model"];

IF SMFIOps.Ambiguous[version] THEN create ← BasicTime.nullGMT

ELSE {

create ← CS.GMTFromRope[version

! UNWIND => NULL;

ANY => {GOTO badSyntax}];

};

fName ← FS.FileInfo[name~name, wantedCreatedTime~create,

wDir~(IF g.model # NIL

THEN g.model.wDir

ELSE ViewerTools.GetContents[g.wDirNameViewer])

! FS.Error => {

IF error.code = $illegalName THEN GOTO badSyntax

ELSE GOTO noFile}].fullFName;

IF SMFIOps.Ambiguous[version] THEN fName ← fName.Substr[0, fName.Find[s2~"!"]];

[] ← TiogaMenuOps.Open[fName];

EXITS

badSyntax => g.ttyout.PutRope["Error - selection is an ill-formed file name\n"];

noFile => g.ttyout.PutF["Error - file %g could not be opened\n", IO.rope[name]];

}

};

InternalStartModel: PROC[g: Global] ~ {

modelFileName: Rope.ROPE;

wDir: Rope.ROPE;

IF g.state ~= $idle THEN InternalStopModel[g];

now set the contents

wDir ← ViewerTools.GetContents[g.wDirNameViewer];

modelFileName ← ViewerTools.GetContents[g.modelFileNameViewer];

IF modelFileName.IsEmpty THEN {

g.ttyout.PutRope["Error - no model source input file\n"];

GOTO failed};

IF ~CS.EndsIn[modelFileName, ".model"] THEN

modelFileName ← modelFileName.Concat[".model"];

g.model ← SMOps.NewModel[g.ttyin, g.ttyout, g.msgout];

(g.model.tm).Initialize;

g.modelFileName ← modelFileName;

g.model.wDir ← wDir;

g.modelUpdated ← g.modelSuperseded ← FALSE;

SetState[g, $unparsed];

ViewerTools.InhibitUserEdits[g.modelFileNameViewer];

ViewerTools.InhibitUserEdits[g.wDirNameViewer];

EXITS

failed => NULL;

}; -- file remains open

InternalParse: PROC[g: Global, autoNotice: BOOL←FALSE] ~ {

IF g.state = $unparsed THEN { -- must (re)parse

file: FS.OpenFile ← FS.nullOpenFile;

input: IO.STREAM ← NIL;

file ← FS.Open[name~g.modelFileName, wDir~g.model.wDir

! FS.Error => {

g.ttyout.PutF["Error - file %g could not be opened\n", IO.rope[g.modelFileName]];

GOTO failed}];

input ← file.StreamFromOpenFile[];

g.modelFileVersion ← file.GetInfo[].created;

Labels.SetDisplayStyle[g.stateLabel, $BlackOnGrey];

g.model.tree ← SMUtil.ParseStream[m~g.model, source~input];

input.Close[];

Labels.SetDisplayStyle[g.stateLabel, $BlackOnWhite];

IF g.model.tree # Tree.null THEN {

SetState[g, $parsed];

IF autoNotice THEN InternalNoticeAll[g];

IF g.debugLevel <= 1 THEN {

SMUtil.PrintTree[g.model, g.model.tree];

SMUtil.PrettyPrint[g.model.out, g.model.tree, g.model.comments]};

};

EXITS

failed => NULL;

};

Process.CheckForAbort[]};

InternalNoticeAll: PROC[g: Global] ~ {

nChanged: NAT ← 0;

LookForSource: TreeOps.Scan ~ {

WITH t SELECT FROM

node: Tree.Handle =>

IF TreeOps.OpName[node] = $unitId THEN {

tag: Rope.Text ~ ShortName[node];

SELECT TRUE FROM

CS.EndsIn[tag, ".mesa"] =>

IF NoticeSource[g, node, FALSE] THEN nChanged ← nChanged + 1;

CS.EndsIn[tag, ".model"] =>

IF NoticeSource[g, node, FALSE] THEN {

nChanged ← nChanged + 1;

TreeOps.PutExt[node, Tree.null]}; -- force reparsing of embedded model

CS.EndsIn[tag, ".bcd"] =>

IF NoticeBcd[g, node] THEN nChanged ← nChanged + 1;

CS.EndsIn[tag, ".modelBcd"] =>

IF NoticeBcd[g, node] THEN {

nChanged ← nChanged + 1;

TreeOps.PutExt[node, Tree.null]}; -- force reparsing of embedded model

ENDCASE => NULL;

}

ELSE TreeOps.ScanSons[node, LookForSource];

ENDCASE => NULL;

Process.CheckForAbort[]};

g.ttyout.PutChar['\n];

IF g.state >= $parsed THEN {

LookForSource[g.model.tree]; g.noticeList ← NIL};

g.ttyout.PutF["%d files noticed.\n\n", IO.card[nChanged]];

IF nChanged > 0 THEN {

g.modelUpdated ← TRUE;

SetState[g, MIN[g.state, $parsed]]; g.model.val ← NIL}; -- force reevaluation

};

InternalCheck: PROC[g: Global] ~ {

[] ← RecordNoticedFiles[g];

IF g.state = $parsed THEN { -- must (re)evaluate

g.model.errors ← FALSE; -- set by evaluation errors

Labels.SetDisplayStyle[g.stateLabel, $BlackOnGrey];

g.model.val ← SMEval.Eval[g.model, g.model.tree, NIL];

Labels.SetDisplayStyle[g.stateLabel, $BlackOnWhite];

IF g.debugLevel <= 2 THEN {

SMUtil.PrintTree[g.model, g.model.val]; (g.model.out).PutRope["\n"]};

IF g.debugLevel <= 3 THEN SMUtil.PrettyPrint[g.model.out, g.model.val, NIL];

IF ~g.model.errors THEN SetState[g, $checked]};

Process.CheckForAbort[]};

InternalCompile: PROC[g: Global, replacement: BOOL] ~ {

IF g.state = $checked THEN {

InternalTemporary[g];

Labels.SetDisplayStyle[g.stateLabel, $BlackOnGrey];

IF ~replacement THEN g.replaceable ← FALSE;

IF SMComp.CompileAll[g.model, g.model.val, replacement].completed THEN

SetState[g, $compiled];

Labels.SetDisplayStyle[g.stateLabel, $BlackOnWhite]};

Process.CheckForAbort[]};

InternalBind: PROC[g: Global] ~ {

IF g.state >= $compiled THEN {

ms: SMOps.MS ~ g.model;

Labels.SetDisplayStyle[g.stateLabel, $BlackOnGrey];

[] ← SMLDriver.Bind[

CS.RootName[g.modelFileName], g.modelFileVersion, ms.val, ms.z, ms.tm, ms.out, ms.wDir];

Labels.SetDisplayStyle[g.stateLabel, $BlackOnWhite]};

Process.CheckForAbort[]};

InternalLoad: PROC[g: Global, replacement: BOOL] ~ {

IF g.state = $compiled THEN {

Labels.SetDisplayStyle[g.stateLabel, $BlackOnGrey];

IF ~(g.model.ls).LoadAndBind[g.model.val, g.model.wDir, replacement].errors THEN {

SetState[g, $loaded]; g.replaceable ← TRUE};

Labels.SetDisplayStyle[g.stateLabel, $BlackOnWhite]};

Process.CheckForAbort[]};

InternalStart: PROC[g: Global] ~ {

IF g.state = $loaded THEN {

Labels.SetDisplayStyle[g.stateLabel, $BlackOnGrey];

IF ~(g.model.ls).Started THEN (g.model.ls).StartAll[g.model.val];

Labels.SetDisplayStyle[g.stateLabel, $BlackOnWhite];

SetState[g, $run]};

Process.CheckForAbort[]};

InternalTemporary: PROC[g: Global] ~ {

FoldPatches[g.model];

IF g.modelUpdated THEN {

IF ~g.modelSuperseded THEN {

file: FS.OpenFile ~ FS.Create[name~g.modelFileName, keep~2, wDir~g.model.wDir];

s: IO.STREAM ← file.StreamFromOpenFile[accessRights~$write];

g.modelFileVersion ← file.GetInfo[].created;

SMUtil.PrettyPrint[s, g.model.tree, g.model.comments];

g.ttyout.PutF["new model on %g\n\n", IO.rope[file.GetName[].fullFName]];

s.Close;

g.modelUpdated ← FALSE}

ELSE g.ttyout.PutF["Warning: model was manually edited, new model not written\n\n"]}

};

InternalStopModel: PROC[g: Global] ~ {

IF g.state # $idle THEN {

InternalTemporary[g];

InternalUnload[g, FALSE];

(g.model.tm).Finalize;

g.replaceable ← g.modelSuperseded ← FALSE;

g.model.val ← NIL; g.model ← NIL};

SMFIOps.Reset[]; SMProj.Reset[];--

ViewerTools.EnableUserEdits[g.modelFileNameViewer];

ViewerTools.EnableUserEdits[g.wDirNameViewer];

SetState[g, $idle]};

InternalUnload: PROC[g: Global, unloadBcd: BOOL] ~ {

IF g.model # NIL AND (g.model.ls).Loaded THEN {

Labels.SetDisplayStyle[g.stateLabel, $BlackOnGrey];

(g.model.ls).Unload[g.model.val, unloadBcd];

Labels.SetDisplayStyle[g.stateLabel, $BlackOnWhite];

g.replaceable ← FALSE;

SetState[g, MIN[g.state, $compiled]]};

Process.CheckForAbort[]};

ClearExtensions: PROC[parseTree: Tree.Link] ~ {

only does this for the parse tree

ANode: TreeOps.Scan ~ {

WITH t SELECT FROM

node: Tree.Handle => {

SELECT TreeOps.OpName[node] FROM

$none, $unitId => NULL;

ENDCASE => TreeOps.PutExt[node, Tree.null];

TreeOps.ScanSons[node, ANode]};

ENDCASE => NULL

};

ANode[parseTree]};

ShortName: PROC[unitId: Tree.Link] RETURNS[Rope.Text] ~ {

RETURN [NARROW[TreeOps.NthSon[unitId, 3]]]};

NoticeFile: PROC[g: Global, unitId: Tree.Link, create: BasicTime.GMT]

RETURNS[changed: BOOL] ~ {

version: Rope.Text ~ NARROW[TreeOps.NthSon[unitId, 4]];

oldCreate: BasicTime.GMT ~ (IF SMFIOps.Ambiguous[version]

THEN BasicTime.nullGMT ELSE CS.GMTFromRope[version]);

changed ← (create # BasicTime.nullGMT AND create # oldCreate);

IF changed THEN {

g.ttyout.PutF["Notice %g\n", IO.rope[ShortName[unitId]]];

TreeOps.PutNthSon[unitId, 4, CS.RopeFromGMT[create].Flatten[]]};

RETURN};

NoticeSource: PROC[g: Global, unitId: Tree.Link, new: BOOL] RETURNS[changed: BOOL] ~ {

fName: Rope.ROPE ~ SMFIOps.UnitToRope[unitId];

fiSrc: SMFI.SrcFileInfo ~ SMFIOps.NewestSource[fName, g.model.wDir];

changed ← NoticeFile[g, unitId, fiSrc.create];

IF changed THEN {

TreeOps.PutExt[unitId, fiSrc];

IF new THEN fiSrc.new ← TRUE};

RETURN};

NoticeBcd: PROC[g: Global, unitId: Tree.Link] RETURNS[changed: BOOL] ~ {

fName: Rope.ROPE ~ SMFIOps.UnitToRope[unitId];

RETURN[NoticeFile[g, unitId, SMFIOps.NewestBcd[fName, g.model.wDir].create]]};

SameTag: PROC[unitId: Tree.Link, tag: Rope.Text] RETURNS[BOOL] ~ {

RETURN[

tag.Equal[ShortName[unitId], FALSE] AND

TreeOps.NthSon[unitId, 1] = Tree.null AND TreeOps.NthSon[unitId, 2] = Tree.null]

};

RecordNoticedFiles: PROC[g: Global] RETURNS[noticedFile: BOOL←FALSE] ~ {

maxState: ModelState ← MIN[g.state, $checked];

ms: SMOps.MS ~ g.model;

SameTyped: PROC[oldFile: Tree.Ext, newUnitId: Tree.Link] RETURNS[BOOL] ~ {

IF oldFile = NIL OR maxState < $checked THEN RETURN[FALSE]

ELSE {

oldFi: SMFI.SrcFileInfo ~ NARROW[oldFile];

newFi: SMFI.SrcFileInfo;

[] ← SMFIOps.EvaluateUnitId[ms, newUnitId];

newFi ← NARROW[TreeOps.GetExt[newUnitId]];

RETURN[SMEval.Equiv[ms, oldFi.type, newFi.type]]}

};

LookForSource: TreeOps.Scan ~ {

WITH t SELECT FROM

node: Tree.Handle =>

IF TreeOps.OpName[node] = $unitId THEN

FOR l: LIST OF Rope.Text ← g.noticeList, l.rest UNTIL l = NIL DO

IF SameTag[node, l.first] THEN {

oldExt: Tree.Ext ~ TreeOps.GetExt[node];

IF NoticeSource[g, node, TRUE] THEN {

IF SameTyped[oldExt, node] THEN

ms.patches ← (ms.z).CONS[[old: oldExt, new: TreeOps.GetExt[node]], ms.patches]

ELSE maxState ← $parsed;

noticedFile ← TRUE};

EXIT} -- can ignore multiple entries

ENDLOOP

ELSE TreeOps.ScanSons[node, LookForSource];

ENDCASE => NULL;

};

IF g.noticeList # NIL AND g.state >= $parsed THEN {

LookForSource[g.model.tree]; g.noticeList ← NIL};

IF noticedFile THEN {

g.modelUpdated ← TRUE;

SetState[g, MIN[g.state, maxState]];

IF g.state < $checked THEN { -- force reevaluation

g.model.val ← Tree.null; g.model.patches ← NIL};

}

};

FoldPatches: PROC[ms: SMOps.MS] ~ {

IF ms.patches # NIL THEN {

PatchNode: TreeOps.Map ~ {

WITH t SELECT FROM

node: Tree.Handle => {

v ← TreeOps.UpdateLeaves[ms.tm, node, PatchNode];

WITH TreeOps.GetExt[v] SELECT FROM

proj: SMProj.Proj => TreeOps.PutExt[v, Tree.null];

ENDCASE;

};

srcFi: SMFI.SrcFileInfo => {

FOR p: SMOps.PatchList ← ms.patches, p.rest UNTIL p = NIL DO

IF p.first.old = t THEN {v ← p.first.new; EXIT};

REPEAT

FINISHED => v ← t

ENDLOOP

};

ENDCASE => v ← t;

RETURN};

ms.val ← PatchNode[ms.tm, ms.val]; ms.patches ← NIL}

};

SML: Commander.CommandProc ~ {

g: Global;

g ← Create[NARROW[ProcessProps.GetProp[$WorkingDirectory]]];

[] ← SMComp.LoadCompiler[g.msgout]};

module initialization

CS.Init[];

destroyEventRegistration ← ViewerEvents.RegisterEventProc[DestroyEvent, $destroy];

Commander.Register["SML", SML, "Cedar System Modeller"];