-- SMIntImpl.mesa
-- last edit by Schmidt, May 27, 1983 7:12 pm
-- last edit by Satterthwaite, August 12, 1983 9:54 am

DIRECTORY
  Buttons: TYPE USING [Button, ButtonProc],
  Containers: TYPE USING [ChildXBound, ChildYBound, Container, Create],
  CS: TYPE USING [CardFromRope, EndsIn, RopeFromCard, SetPFCodes],
  Directory: TYPE USING [DeleteFile, Error, Rename],
  FileIO: TYPE USING [Open, OpenFailed],
  IO: TYPE USING [
    card, Close, PutF, PutFR, ResetUserAbort, RIS, rope, SetUserAbort,
    STREAM, time, UserAborted],
  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], 
  Rope: TYPE USING [Cat, Equal, Flatten, IsEmpty, ROPE, Text],
  Rules: TYPE USING [Create, Rule],
  SMBcd: TYPE USING[WriteModelBcd],
  SMComp: TYPE USING [CompileAll, LoadCompiler],
  SMDF: TYPE USING [WriteDFFile],
  SMEval: TYPE USING [Eval, UnitToRope],
  SMFI: TYPE USING [SrcFileInfo],
  SMFIOps: TYPE USING [Ambiguous, --Flush,-- NewestSource],
  SMLDriver: TYPE USING [LoadAndBind, Loaded, StartAll, Started, Unload],
  SMOps: TYPE USING [MS, NewModel],
  SMUtil: TYPE USING [ParseStream, PrettyPrint, PrintTree],
  SMTree: TYPE Tree USING [Handle, Link, null],
  SMTreeOps: TYPE --TreeOps-- USING [
    Initialize, Finalize, NthSon, OpName, PutExt, PutNthSon, Scan, ScanSons],
  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 [
    GetContents, GetSelectionContents, MakeNewTextViewer, SetSelection];

SMIntImpl: CEDAR PROGRAM 
    IMPORTS
      Containers, CS, Directory, FileIO, MBQueue, IO, Labels, List, Menus, Rope, Rules,
      SMBcd, SMComp, SMDF, SMEval, SMFIOps, SMLDriver, SMOps, SMUtil,
      SMTreeOps, TypeScript, ViewerEvents, ViewerOps, ViewerIO, ViewerTools ~ {
  OPEN Tree~~SMTree, TreeOps~~SMTreeOps;

 -- modeller state
 
  ModelState: TYPE~{	-- ordered
    idle, unparsed, parsed, evaluated, 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,
   -- fields
    startModellingFileNameButton: Buttons.Button_NIL,
    startModellingFileNameViewer: ViewerClasses.Viewer_NIL,
    confirmButton: Buttons.Button_NIL,
    confirmViewer: ViewerClasses.Viewer_NIL,
    attachEditorButton: Buttons.Button_NIL,
    attachEditorLabel: ViewerClasses.Viewer_NIL,
   -- modelling state
    state: ModelState_$idle,
    stateLabel: Labels.Label_NIL,
   -- other objects
    q: MBQueue.Queue_NIL,
    noticeList: LIST OF Rope.Text_NIL,	-- files that have been noticed
    confirmCompiles: REF BOOL,
    attachEditor: BOOL_TRUE,
    attachEditorRef: REF ANY_NIL,
    model: SMOps.MS_NIL,
    modelFileName: Rope.Text_NIL,
    modelUpdated: 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: CARDINAL ~ 15; 
  entryVSpace: CARDINAL ~ 7; 
  entryHSpace: CARDINAL ~ 10; 
  
  Create: PROC RETURNS[g: Global] ~ {
    ttyTypeScript, msgTypeScript: TypeScript.TS;
    vName: Rope.ROPE ~ IO.PutFR["Cedar Modeller, started on %t", IO.time[]];
    menu: Menus.Menu ~ Menus.CreateMenu[lines~3];

    MenuItem: PROC[name: Rope.ROPE, proc: Menus.MenuProc, line: NAT] ~ {
      menu.InsertMenuEntry[(g.q).CreateMenuEntry[name, proc, g], line]};
      
    g _ NEW[GlobalRecord _ [
    	confirmCompiles~NEW[BOOL_FALSE],
    	container~Containers.Create[info~[name~vName, iconic~FALSE, scrollable~FALSE]],
        q~MBQueue.Create[]]];
    ViewerOps.AddProp[g.container, $SMGlobalRef, g];
   -- first row of menu items
    MenuItem["StopModel", StopModel, 0]; 
    MenuItem["Continue", Continue, 0]; 
    MenuItem["Begin", Begin, 0]; 
    MenuItem["NoticeAll", NoticeAll, 0]; 
    MenuItem["StartModel", StartModel, 0]; 
   -- second row of menu items
    MenuItem["NewModeller", NewModeller, 1]; 
    MenuItem["Bind", Bind, 1]; 
    MenuItem["MakeDFFile", MakeDFFile, 1]; 
    MenuItem["MakeModelBcd", MakeModelBcd, 1]; 
   -- third row of menu items
    MenuItem["Debug", Debug, 2]; 
    menu.InsertMenuEntry[Menus.CreateEntry["Abort", Abort, g], 2]; 
    MenuItem["Unload", Unload, 2]; 
    MenuItem["Start", Start, 2]; 
    MenuItem["Load", Load, 2]; 
    MenuItem["Compile", Compile, 2]; 
    MenuItem["Check", Check, 2];
   --
    ViewerOps.SetMenu[g.container, menu, FALSE];
    [ttyTypeScript, msgTypeScript] _ BuildUserInput[g];
   -- 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;
    CS.SetPFCodes[g.ttyout];  CS.SetPFCodes[g.msgout];
    IF g.attachEditor THEN AttachSymbiote[g];
    globalList _ CONS[g, globalList]};

  BuildUserInput: PROC[g: Global] RETURNS[ttyTypeScript, msgTypeScript: TypeScript.TS] ~ {
    heightSoFar: CARDINAL _ 0; 
    l: ViewerClasses.Viewer _ NIL;
    rule: Rules.Rule;
   
    CreateButton: PROC[bname, lname: Rope.Text, 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 _ MBQueue.CreateButton[
		q~g.q,
		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~TRUE]];
      };

   -- first line
    [g.startModellingFileNameButton, ] _ CreateButton["ModelName:", NIL, TRUE];
    l _ g.startModellingFileNameViewer _ 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.startModellingFileNameViewer];
    heightSoFar _ heightSoFar + l.wh + entryVSpace/2;
   -- second 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];
    heightSoFar _ heightSoFar + l.wh + entryVSpace/2;
   -- third line
    [g.confirmButton, g.confirmViewer] _ CreateButton["ConfirmCompiles:", "FALSE", TRUE];
    IF g.confirmCompiles^ THEN Labels.Set[g.confirmViewer, "TRUE"];
    [g.attachEditorButton, g.attachEditorLabel] _ CreateButton["AttachEditor:", "FALSE", FALSE];
    IF g.attachEditor THEN Labels.Set[g.attachEditorLabel, "TRUE"];
    heightSoFar _ heightSoFar + entryVSpace/2+l.wh;
   --
   -- 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",
      $evaluated => "checked",
      $compiled => "compiled",
      $loaded => "loaded",
      $run => "started",
      ENDCASE => "ERROR"];
    g.state _ state};
    
  PushButton: Buttons.ButtonProc ~ {
    g: Global ~ NARROW[clientData];
    SELECT NARROW[parent, ViewerClasses.Viewer] FROM
      g.startModellingFileNameButton =>
	ViewerTools.SetSelection[g.startModellingFileNameViewer, NIL];
      g.confirmButton => {
	g.confirmCompiles^ _ ~g.confirmCompiles^;
	Labels.Set[g.confirmViewer, IF g.confirmCompiles^ THEN "TRUE" ELSE "FALSE"]};
      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;
    };
	
 -- BUTTON PROCS

 -- not on the queue
  Abort: Menus.MenuProc ~ {
    g: Global ~ NARROW[clientData];
    MBQueue.Flush[g.q];
    g.ttyin.SetUserAbort[]};
	
  Begin: Menus.MenuProc ~ {
    g: Global ~ NARROW[clientData];
      {
      ENABLE ABORTED, IO.UserAborted => {GOTO out};
      InternalUnload[g, TRUE];
      IF g.state = $idle THEN InternalStartModel[g, TRUE];	-- auto StartModel
      ClearExtensions[g.model.tree];
      InternalCheck[g];
      InternalCompile[g, FALSE];
      InternalLoad[g, FALSE];
      InternalStart[g];
      EXITS
	out => {g.ttyin.ResetUserAbort[]; g.ttyout.PutF["Begin aborted\n"]};
      };
    SetState[g, g.state]};

  Bind: Menus.MenuProc ~ {
    g: Global ~ NARROW[clientData];
    g.ttyout.PutF["Bind not implemented yet.\n"];
    g.ttyout.PutF["-------------\n"]};

  Check: Menus.MenuProc ~ {
    g: Global ~ NARROW[clientData];
      {
      ENABLE ABORTED, IO.UserAborted => {GOTO out};
      IF g.state = $idle THEN InternalStartModel[g, TRUE];
      InternalCheck[g];
      EXITS
	out => {g.ttyin.ResetUserAbort[]; g.ttyout.PutF["Check aborted\n"]};
      };
    SetState[g, g.state]};

  Compile: Menus.MenuProc ~ {
    g: Global ~ NARROW[clientData];
      {
      ENABLE ABORTED, IO.UserAborted => {GOTO out};
      IF g.state = $idle THEN InternalStartModel[g, TRUE];
      InternalCheck[g];
      InternalCompile[g, FALSE];
      EXITS
	out => {g.ttyin.ResetUserAbort[]; g.ttyout.PutF["Compilation aborted\n"]};
      };
    SetState[g, g.state]};

  Continue: Menus.MenuProc ~ {
    g: Global ~ NARROW[clientData];
      {
      ENABLE ABORTED, IO.UserAborted => {GOTO out};
      IF g.state = $idle THEN InternalStartModel[g, TRUE];	-- auto StartModel
      InternalCheck[g];
      InternalCompile[g, TRUE];
      InternalLoad[g, TRUE];
      InternalStart[g];
      EXITS
	out => {g.ttyin.ResetUserAbort[]; g.ttyout.PutF["Continue aborted\n"]};
      };
    SetState[g, g.state]};

  Debug: Menus.MenuProc ~ {
    g: Global ~ NARROW[clientData];
    g.ttyout.PutF["-------------\n"];
    IF g.state = $idle THEN {
      ENABLE ABORTED, IO.UserAborted => {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.PutF["\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.ttyin.ResetUserAbort[]; g.ttyout.PutF["Debug aborted\n"]};
      };
    g.ttyout.PutF["-------------\n"]};

  Load: Menus.MenuProc ~ {
    g: Global ~ NARROW[clientData];
      {
      ENABLE ABORTED, IO.UserAborted => {GOTO out};
      InternalLoad[g, FALSE];
      EXITS
	out => {g.ttyin.ResetUserAbort[]; g.ttyout.PutF["Load aborted\n"]};
      };
    SetState[g, g.state]};

  MakeDFFile: Menus.MenuProc ~ {
    g: Global ~ NARROW[clientData];
      {
      ENABLE ABORTED, IO.UserAborted => {GOTO out};
      IF g.state >= $evaluated THEN {
        InternalTemporary[g];
        SMDF.WriteDFFile[g.model, g.model.val, g.modelFileName, g.modelFileName]};
      EXITS
        out => {g.ttyin.ResetUserAbort[]; g.ttyout.PutF["MakeDFFile aborted\n"]};
      };
    };

  MakeModelBcd: Menus.MenuProc ~ {
    g: Global ~ NARROW[clientData];
    {
      ENABLE ABORTED, IO.UserAborted => {GOTO out};
      IF g.state >= $evaluated THEN {
	InternalTemporary[g];
	SMBcd.WriteModelBcd[g.model, g.model.val, g.modelFileName, g.modelFileName]};
      EXITS
        out => {g.ttyin.ResetUserAbort[]; g.ttyout.PutF["MakeModelBcd aborted\n"]};
      };
    };

  NewModeller: Menus.MenuProc ~ {
    [] _ Create[]};
	
  NoticeAll: Menus.MenuProc ~ {
    g: Global ~ NARROW[clientData];
      {
      ENABLE ABORTED, IO.UserAborted => {GOTO out};
      InternalNoticeAll[g];
      EXITS
	out => {g.ttyin.ResetUserAbort[]; g.ttyout.PutF["NoticeAll aborted\n"]};
      };
    };

  StartModel: Menus.MenuProc ~ {
    g: Global ~ NARROW[clientData];
      {
      ENABLE ABORTED, IO.UserAborted => {GOTO out};
      InternalStartModel[g];
      EXITS
	out => {g.ttyin.ResetUserAbort[]; g.ttyout.PutF["StartModelling aborted\n"]};
      };
    SetState[g, g.state]};

  Start: Menus.MenuProc ~ {
    g: Global ~ NARROW[clientData];
      {
      ENABLE ABORTED, IO.UserAborted => {GOTO out};
      InternalStart[g];
      EXITS
	out => {g.ttyin.ResetUserAbort[]; g.ttyout.PutF["Start aborted\n"]};
      };
    SetState[g, g.state]};

  StopModel: Menus.MenuProc ~ {
    g: Global ~ NARROW[clientData];
      {
      ENABLE ABORTED, IO.UserAborted => {GOTO out};
      InternalStopModel[g];
      EXITS
	out => {g.ttyin.ResetUserAbort[]; g.ttyout.PutF["StopModelling aborted\n"]};
      };
    SetState[g, $idle]};

  Unload: Menus.MenuProc ~ {
    g: Global ~ NARROW[clientData];
      {
      ENABLE ABORTED, IO.UserAborted => {GOTO out};
      InternalUnload[g, TRUE];
      EXITS
        out => {g.ttyin.ResetUserAbort[]; g.ttyout.PutF["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.PutF["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.PutF["Editor detached from this modeller.\n"]};

-- this is the procedure called by the editor
-- can't print anything in this procedure
  SaveEvent: ViewerEvents.EventProc ~ {
    ENABLE ANY => {GOTO out};
    IF viewer.file # NIL THEN {
      flat: Rope.Text ~ viewer.file.Flatten[];
      IF CS.EndsIn[flat, ".mesa"] THEN	-- only source now
	FOR l: LIST OF Global _ globalList, l.rest UNTIL l = NIL DO
	  l.first.noticeList _ CONS[flat, l.first.noticeList];
	  ENDLOOP;
      }
    EXITS
      out => NULL;
    };

  DestroyEvent: ViewerEvents.EventProc ~ {
    IF event = $destroy THEN {
      g: Global ~ NARROW[ViewerOps.FetchProp[viewer, $SMGlobalRef]];
      IF g ~= NIL THEN DetachSymbiote[g, FALSE];
      IF globalList = NIL THEN {
	ViewerEvents.UnRegisterEventProc[destroyEventRegistration, $destroy];
	destroyEventRegistration _ NIL;
	RETURN};
      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]]];
	  RETURN};
	ENDLOOP;
      };
    };


  InternalStartModel: PROC[g: Global, autoNotice: BOOL_FALSE] ~ {
    modelFileName: Rope.Text;
    input: IO.STREAM _ NIL;
    IF g.state ~= $idle THEN InternalStopModel[g];
    -- now set the contents
    modelFileName _ ViewerTools.GetContents[g.startModellingFileNameViewer].Flatten[];
    IF modelFileName.IsEmpty THEN {
      g.ttyout.PutF["Error - no model source input file\n"];
      GOTO failed};
    IF ~CS.EndsIn[modelFileName, ".model"]
      THEN modelFileName _ modelFileName.Cat[".model"].Flatten[];
    input _ FileIO.Open[modelFileName
      ! FileIO.OpenFailed => {
        g.ttyout.PutF["Error - file %s could not be opened\n", IO.rope[modelFileName]];
        GOTO failed}];
    g.model _ SMOps.NewModel[g.ttyin, g.ttyout, g.msgout];
    (g.model.tm).Initialize;
    g.modelFileName _ modelFileName;
    g.modelUpdated _ FALSE;  SetState[g, $unparsed];
    Labels.SetDisplayStyle[g.stateLabel, $BlackOnGrey];
    g.model.tree _ SMUtil.ParseStream[m~g.model, source~input];
    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
    };		-- file remains open
	
  InternalNoticeAll: PROC[g: Global] ~ {
    nChanged: CARDINAL _ 0;
	
      LookForSource: TreeOps.Scan ~ {
	WITH t SELECT FROM
	  node: Tree.Handle =>
	    IF TreeOps.OpName[node] = $unitId THEN {
	      fileName: Rope.Text ~ LocalName[node];
	      IF CS.EndsIn[fileName, ".mesa"] AND NoticeSource[g, node, fileName, FALSE] THEN
	        nChanged _ nChanged + 1
	      ELSE IF CS.EndsIn[fileName, ".model"]
	       AND NoticeSource[g, node, fileName, FALSE] THEN {
	        nChanged _ nChanged + 1;
	        TreeOps.PutExt[node, Tree.null]}	-- force reparsing of embedded model
	      }
	    ELSE TreeOps.ScanSons[node, LookForSource];
	  ENDCASE => NULL;
	};

    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).PutF["\n"]};
      IF g.debugLevel <= 3 THEN SMUtil.PrettyPrint[g.model.out, g.model.val, NIL];
      IF ~g.model.errors THEN SetState[g, $evaluated]};
    };
    
  InternalCompile: PROC[g: Global, replacement: BOOL] ~ {
    IF g.state = $evaluated THEN {
      InternalTemporary[g];
      Labels.SetDisplayStyle[g.stateLabel, $BlackOnGrey];
      IF SMComp.CompileAll[g.model, g.model.val, g.confirmCompiles, replacement].complete THEN
        SetState[g, $compiled];
      Labels.SetDisplayStyle[g.stateLabel, $BlackOnWhite]};
    };
	
  InternalLoad: PROC[g: Global, replacement: BOOL] ~ {
    IF g.state = $compiled THEN {
      Labels.SetDisplayStyle[g.stateLabel, $BlackOnGrey];
      IF ~(g.model.ls).LoadAndBind[g.model.val, replacement].errors THEN SetState[g, $loaded];
      Labels.SetDisplayStyle[g.stateLabel, $BlackOnWhite]};
    };
	
  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]};
    };
	
  InternalTemporary: PROC[g: Global] ~ {
    IF g.modelUpdated THEN TRUSTED {
      sh: IO.STREAM;
      oldName: Rope.Text ~ g.modelFileName.Cat["$"].Flatten[];
      g.ttyout.PutF["Old model on %s, ", IO.rope[oldName]];
      Directory.DeleteFile[fileName: LOOPHOLE[oldName]
			! Directory.Error => {CONTINUE}];
      Directory.Rename[
	oldName~LOOPHOLE[g.modelFileName], newName~LOOPHOLE[oldName]];
      sh _ FileIO.Open[g.modelFileName, $overwrite];
      SMUtil.PrettyPrint[sh, g.model.tree, g.model.comments];
      sh.Close[];
      g.ttyout.PutF["new model on %s\n\n", IO.rope[g.modelFileName]];
      g.modelUpdated _ FALSE};
    };
	
  InternalStopModel: PROC[g: Global] ~ {
    IF g.state # $idle THEN {
      InternalTemporary[g];
      InternalUnload[g, FALSE];
      (g.model.tm).Finalize;
      g.model.val _ NIL;  g.model _ NIL};
    --SMFIOps.Flush[];  SMProj.Flush[];--
    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];
      SetState[g, MIN[g.state, $compiled]]};
    };
	

 -- only does this for the parse tree
  ClearExtensions: PROC[parseTree: Tree.Link] ~ {

    ANode: TreeOps.Scan ~ TRUSTED {
      WITH t SELECT FROM
	node: Tree.Handle => {
	  IF TreeOps.OpName[node] ~= $none THEN TreeOps.PutExt[node, NIL];
	  TreeOps.ScanSons[node, ANode]};
	ENDCASE => NULL
      };
		
    ANode[parseTree]};


  LocalName: PROC [uid: Tree.Link] RETURNS[Rope.Text] ~ {
    RETURN [SMEval.UnitToRope[TreeOps.NthSon[uid, 3]].Flatten[]]};
    
  NoticeSource: PROC[g: Global, unitId: Tree.Link, fileName: Rope.Text, new: BOOL]
      RETURNS[changed: BOOL] ~ {
    fiSrc: SMFI.SrcFileInfo ~ SMFIOps.NewestSource[fileName];
    version: Rope.Text ~ NARROW[TreeOps.NthSon[unitId, 4]];
    create: LONG CARDINAL ~
	(IF SMFIOps.Ambiguous[version] THEN 0 ELSE CS.CardFromRope[version]);
    changed _ (fiSrc.create # 0 AND fiSrc.create # create);
    IF changed THEN {
      g.ttyout.PutF["Notice %s\n", IO.rope[fileName]];
      IF new THEN fiSrc.new _ TRUE;
      TreeOps.PutNthSon[unitId, 4, CS.RopeFromCard[fiSrc.create].Flatten[]]};
    RETURN};

  RecordNoticedFiles: PROC[g: Global] RETURNS[noticedFile: BOOL _ FALSE] ~ {
	
    LookForSource: TreeOps.Scan ~ {
      WITH t SELECT FROM
	node: Tree.Handle =>
	  IF TreeOps.OpName[node] = $unitId THEN {
	    fileName: Rope.Text ~ LocalName[node];
	    FOR l: LIST OF Rope.Text _ g.noticeList, l.rest UNTIL l = NIL DO
	      IF fileName.Equal[l.first, FALSE]
	       AND NoticeSource[g, node, fileName, TRUE] THEN {
	        noticedFile _ TRUE; EXIT}	-- new file
	      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, $parsed]];  g.model.val _ NIL};	-- force reevaluation
    };
	

  {
  g: Global;
  destroyEventRegistration _ ViewerEvents.RegisterEventProc[DestroyEvent, $destroy];
  g _ Create[];
  [] _ SMComp.LoadCompiler[g.msgout];
  };

  }.