[Inquiry] Re: Theme One Program

[Jon Awbrey]

o~~~~~~~~~o~~~~~~~~~o~~~~~~~~~o~~~~~~~~~o~~~~~~~~~o

TOP.  Note 4

o~~~~~~~~~o~~~~~~~~~o~~~~~~~~~o~~~~~~~~~o~~~~~~~~~o

{ compiler: turbo pascal, version 5.0, }
{ (c) 1987, 1988 borland international }
{$M 53248,0,655360} { stack and heap   }
{$B+} { boolean complete evaluation on }

{ project: theme
  segment: learner + modeler                         copyright: 1984 - 2003
  version: 1                                                by: jon awbrey }

o~~~~~~~~~o~~~~~~~~~o~~~~~~~~~o~~~~~~~~~o~~~~~~~~~o

function study (this: idea): idea;
var here, i, now, lex, log: idea;

function scene (this: idea): idea;
var here: idea;
begin
 here := nil;
 if this <> nil then here := frame ('log', this);
 if here  = nil then here := frame ('num', this);
 scene := here
end;

function query (this: idea): idea;
var here: idea;
begin
 here := nil;
 if this <> nil then
  begin
   write   ('< enter lines of inquiry >');
   writeln ('< press control-z to end >' : 54);  reset (con);
   here := chart (con, kind ('log'), this);    rewrite (con)
  end;
 query := here
end;

function fake (this: idea): idea;
forward;

function twin (this: idea): idea;
var here: idea;
begin
 here := nil;
 if this <> nil then
  if lief (this) <> nil then here := image (fake (sequel (this)))
   else if rest (this) = nil then here := pend (this);
 twin := here
end;

function fake { (this: idea): idea };
var here, there: idea;
begin
 here := nil;
 if this <> nil then
  begin
   there := this;
   repeat there := next (there);
    here := graft (here, twin (there))
   until there = this
  end;
 fake := here
end;

function mock (this: idea): idea;
var here, there: idea;
begin
 here := nil;
 if this <> nil then
  begin
   there := this;
   repeat there := next (there);
    case arch (there) of
     links: begin
             here := trip (graft (here, inset (stitch, reck (there))));
             there := sequel (there)
            end;
     right: if rest (next (here)) <> nil then
             begin
              here := trip (inset (next (here), reck (there)));
              there := trip (there)
             end
            else here := critique ('par', here);
     comma: here := graft (here, pend (there))
     else   here := graft (here, plot (pend (there)))
    end
   until there = this
  end;
 mock := here
end;

function seal (this: idea): idea;
var here: idea;
begin
 seal := this;
 if this <> nil then
  begin
   here := this;
   repeat
    with here^ do
     begin
      if sign = right then as := nil
       else if sign = links then here := seal (on);
      here := by
     end
   until here = this
  end
end;

function dupe (thus, this: idea): idea;
var here: idea;
begin
 here := nil;
 if thus <> nil then if this <> nil then
  begin
   thus := seal (thus);
   here := mock (this)
  end;
 dupe := here
end;

function face (this: idea): idea;
var here: idea;
   depth: numb;

function mood (this: idea): mode;
var here: mode;
begin
 here := null;
 if this <> nil then
  if lief (this) <> nil then here := moot
   else if ante (bank (this)) <> nil then here := firm;
 mood := here
end;

function look (this: idea): idea;
var here: idea;
begin
 here := nil;
 if this <> nil then
  begin
   here := this;
   repeat here := next (here);
    until (ante (here) <> nil) or (here = this);
   if ante (here) = nil then here := find (links, this)
  end;
 look := here
end;

function view (this: idea;
              depth: numb): idea;
var here, there: idea;
begin
 here := nil;
 if this <> nil then
  begin
   if depth = 1 then here := look (this)
    else
     begin
      there := this;
      repeat there := next (there);
       here := view (trip (lief (there)), alow (depth))
      until (mood (here) = firm) or (there = this);
      if mood (here) = null then
       repeat there := next (there);
        here := view (trip (lief (there)), alow (depth))
       until (mood (here) = moot) or (there = this)
     end
  end;
 view := here
end;

begin { face }
 here := nil;
 if this <> nil then
  begin
   depth := 0;
   repeat here := view (this, anew (depth))
    until mood (here) <> moot;
   if mood (here) = null then here := nil
  end;
 face := here
end;

function impost (this: idea): idea;
var here, there: idea;
begin
 here := nil;
 if this <> nil then
  begin
   there := this;
   repeat there := next (there);
    here := edge (there)
   until (here <> nil) or (there = this)
  end;
 impost := here
end;

function invest (that, this: idea): idea;
var here, there: idea;
begin
 here := nil;
 if this <> nil then
  begin
   there := this;
   repeat there := next (there);
    here := equity (that, ante (there))
   until (here <> nil) or (there = this)
  end;
 invest := here
end;

function purport (this: idea): idea;
var here: idea;

function import (this: idea): idea;
var here, there, where: idea;

function impact (thus, this: idea): idea;
var here, there, where: idea;
begin
 here := nil;
 if this <> nil then if thus <> nil then
  if rest (this) <> nil then
   begin
    there := fall (thus);  where := rise (thus);
    while there <> where do
     begin
      there := next (there);
      if lief (there) <> nil then
       here := graft (here, import (there))
      else if crest (there) = nil then
       here := graft (here, pend (there))
     end
   end;
 impact := here
end;

begin { import }
 here := nil;
 if this <> nil then
  if lief (this) <> nil then
   begin
    there := sequel (this);  where := impost (there);
    if where <> nil then here := purport (impact (where, there))
     else
      begin
       here := image (purport (there));
       there := sequel (here);  where := impost (there);
       if where <> nil then here := purport (impact (where, there))
      end
   end
  else if rest (this) = nil then here := pend (this);
 import := here
end;

function impute (this: idea): idea;
var here, there, where: idea;
begin
 here := nil;
 if this <> nil then
  begin
   there := this;
   repeat there := next (there);
    here := graft (here, import (there));
    where := edge (here)
   until (where <> nil) or (there = this);
   if where <> nil then here := stitch
  end;
 impute := here
end;

function comport (this: idea): idea;
var here, there: idea;
begin
 here := nil;
 if this <> nil then
  begin
   there := this;
   repeat there := next (there);
    here := graft (here, import (there))
   until there = this
  end;
 comport := here
end;

begin { purport }
 here := nil;
 if this <> nil then
  if find (comma, this) <> nil then here := comport (this)
   else if impost (this) <> nil then here := stitch
    else here := impute (this);
 purport := here
end;

function purpose (this: idea): idea;
begin
 purpose := repose (this, purport (this))
end;

function stone (that, this: idea): idea;
var here, there: idea;
begin
 here := nil;
 if this <> nil then
  if that = nil then here := fake (this)
   else
    begin
     there := this;
     repeat there := next (there);
      if lief (there) <> nil then
       here := graft (here, image (stone (that, trip (there))))
      else if ante (there) <> that then here := graft (here, tend (there))
     until there = this
    end;
 stone := here
end;

function stick (that, this: idea): idea;
var here, there: idea;

function stirp (thus, that, this: idea): idea;
var here: idea;
begin
 here := thus;
 if this <> nil then
  if lief (this) <> nil then
   here := graft (here, image (stick (that, trip (this))))
  else here := graft (here, tend (this));
 stirp := here
end;

function stipe (that, this: idea): idea;
var here, there: idea;
begin
 here := nil;
 if this <> nil then
  begin
   there := this;
   repeat there := next (there);
    here := stirp (here, that, there)
   until there = this
  end;
 stipe := here
end;

function stile (that, this: idea): idea;
var here, there: idea;
begin
 here := nil;
 if this <> nil then
  begin
   there := this;
   repeat there := next (there);
    if ante (there) = that then here := graft (here, stitch)
     else here := stirp (here, that, there)
   until there = this
  end;
 stile := here
end;

begin { stick }
 here := nil;
 if this <> nil then
  if that = nil then here := fake (this)
   else if find (comma, this) <> nil then here := stile (that, this)
    else
     begin
      there := invest (that, this);
      if there <> nil then here := stitch;
      if here = nil then here := stipe (that, this)
     end;
 stick := here
end;

function model (this: idea): idea;
var here, there: idea;

function figure (that, this: idea): idea;
begin
 figure :=
  graft (switch,
  graft (nub (that),
  model (stone (that, this))))
end;

function ground (that, this: idea): idea;
begin
 ground :=
  graft (splice,
  graft (image (nub (that)),
  model (stick (that, this))))
end;

function gestalt (that, this: idea): idea;
begin
 gestalt :=
  stem (graft (
  figure (that, this),
  ground (that, this)))
end;

begin { model }
 here := memcheck (nil);
 if this <> nil then
  begin
   here := purpose (this);  there := ante (face (here));
   if there <> nil then here := repose (here, gestalt (there, here))
  end;
 model := here
end;

function affirm (var thou: text;
		     this: idea): idea;
begin
 affirm := verse (thou, blank + aster, this)
end;

function refute (var thou: text;
                     this: idea): idea;
begin
 refute := verse (thou, blank + minus, this)
end;

function reject (var thou: text;
                     what: mode;
                     this: idea): idea;
var here: idea;
begin
 reject := this;
 if what = null then here := refute (thou, this)
end;

function outline (what: mode;
                  this: idea): idea;
var thou: text;

function circuit (var thou: text;
                       tab: numb;
                      what: mode;
                      this: idea): idea;
var here: idea;

function feature (var thou: text;
                       tab: numb;
                      what: mode;
                      this: idea): idea;
var here: idea;
begin
 feature := this;
 if this <> nil then
  if what <> firm then
   begin
    here := state (thou, skip (thou, tab, this));
    if crest (next (this)) <> nil then here := affirm (thou, this)
     else if edge (next (this)) = nil then here := return (thou, this)
   end
  else if respect (this) <> nil then
   here := return (thou, recall (thou, skip (thou, tab, this)))
end;

function compass (var thou: text;
                       tab: numb;
                      what: mode;
                      this: idea): idea;
var here: idea;
begin
 compass := this;
 if this <> nil then
  if rest (next (cope (this))) <> nil then
   here := affirm (thou, skip (thou, tab, this))
  else if aspect (this) <> nil then
   here := feature (thou, tab, what, this)
  else if lief (this) <> nil then
   if edge (this) <> nil then here := reject (thou, what, this)
    else here := circuit (thou, anon (tab), what, sequel (this))
end;

begin { circuit }
 circuit := this;
 if this <> nil then
  begin
   here := this;
   repeat here := compass (thou, tab, what, next (here))
    until here = this
  end
end;

begin { outline }
 outline := compt (thou, circuit (thou, 0, what, clepe (thou, this)))
end;

function excerpt (this: idea): idea;
var here: idea;

function caption (this: idea): idea;
var here, there: idea;
begin
 here := nil;
 if aspect (this) <> nil then
  begin
   there := next (this);
   if crest (there) <> nil then here := graft (twin (this), mend (there))
    else
     begin
      here := excerpt (there);  there := next (there);
      if edge (here) <> nil then here := graft (stitch, mend (there))
       else here := graft (twin (this), graft (here, mend (there)))
     end
  end;
 caption := here
end;

function extract (this: idea): idea;
var here, there: idea;
begin
 here := nil;
 if rest (this) <> nil then
  begin
   there := this;
   repeat there := next (there);
    here := graft (here, caption (there))
   until there = this
  end;
 extract := here
end;

begin { excerpt }
 here := nil;
 if lief (this) <> nil then
  here := image (extract (sequel (this)));
 excerpt := here
end;

function profile (this: idea): idea;
var thou: text;

function contour (var thou: text;
                      span: numb;
                      this: idea): idea;
var here: idea;
     tab: numb;
begin
 contour := this;
 if this <> nil then
  begin
   here := this;  tab := span;
   repeat here := next (here);
    if respect (here) <> nil then
     here := return (thou, recall (thou, skip (thou, anew (tab), here)))
    else if cope (here) <> nil then tab := span
    else if lief (here) <> nil then
     if edge (here) = nil then if suspect (here) = nil then
      here := obvert (here, contour (thou, tab, sequel (here)))
   until here = this
  end
end;

begin { profile }
 profile := compt (thou, contour (thou, 0, clepe (thou, this)))
end;

function pause (this: idea): idea;
begin
 pause := turn (hold (this))
end;

function reserve (this: idea): idea;
begin
 reserve := pause (save (this))
end;

function interp (what: mode;
                 this: idea): idea;
var here: idea;
begin
 interp := this;
 if this = nil then
  if what = null then here := space (con, this)
   else here := pass (con, 'nil ', this)
end;

function dissert (what: mode;
                  this: idea): idea;
var here: idea;
begin
 dissert := turn (this);
 if this = nil then here := interp (what, this)
  else if what = moot then here := tell (this)
   else here := show (this);
 here := turn (here)
end;

function explain (what: mode;
                  this: idea): idea;
var here: idea;
begin
 explain := turn (this);
 if this = nil then here := interp (what, this)
  else here := show (turn (hold (dump (this))));
 here := turn (here)
end;

function display (this: idea): idea;
var here: idea;
begin
 display := turn (this);
 if prompt ('input') <> nil then here := dissert (firm, this);
 if prompt ('face ') <> nil then here := dissert (moot, face (this));
 here := hold (here)
end;

function expound (that, this: idea): idea;
var i,
    now, who,
    lex, log,
    dup, fak, fac: idea;
begin
 expound := this;
 if this <> nil then
  begin
   i := turn (nil);  now := nil;  who := nil;  lex := that;  log := this;
   if prompt ('log ') <> nil then log := explain (firm, log);
   if prompt ('dupe') <> nil then dup := explain (firm, dupe (lex, log));
   if prompt ('fake') <> nil then fak := explain (firm, fake (log));
   if prompt ('face') <> nil then fac := dissert (moot, face (dup));
   i := ante (fac);
   if prompt ('sense') <> nil then now := dissert (firm, purport (log));
   if prompt ('stone') <> nil then who := dissert (firm, stone (i, now));
   if prompt ('stick') <> nil then who := dissert (firm, stick (i, now));
   i := pause (i)
  end;
 i := clear (i)
end;

begin { study }
 study := this;
 here := turn (nil);
 i := nil;  now := nil;
 lex := fetch (nil);  log := scene (lex);
 if lex <> nil then
  begin
   if permit ('write num file', clear (nil)) <> nil then
    i := reserve (log);
   if permit ('show ram files', clear (nil)) <> nil then
    i := expound (lex, log);
   while permit ('query', clear (nil)) <> nil do
    begin
     here := graft (fake (till (log)), query (turn (lex)));
     if permit ('show files', turn (nil)) <> nil then i := display (here);
     if permit ('model', clear (nil)) <> nil then
      begin
       now := turn (model (till (here)));
       if prompt ('write mod file') <> nil then i := outline (null, now);
       if prompt ('write nom file') <> nil then i := reserve (now);
       if permit ('tenor', clear (nil)) <> nil then
        begin
         i := turn (excerpt (till (now)));
         if prompt ('write ten file') <> nil then i := outline (moot, i);
         if prompt ('write net file') <> nil then i := reserve (i);
         if permit ('canon', clear (nil)) <> nil then
          begin
           i := turn (till (i));
           if prompt ('write can file') <> nil then i := outline (firm, i);
           if prompt ('write nac file') <> nil then i := reserve (i)
          end;
         if permit ('recycle memory', lash (memcheck (clear (nil)))) <> nil
         then i := hold (at (2, 48, memcheck (recycle (till (i)))))
        end;
       if permit ('sense', clear (nil)) <> nil then
        begin
         i := turn (purpose (till (now)));
         if prompt ('write sen file') <> nil then i := profile (i);
         if prompt ('write nes file') <> nil then i := reserve (i)
        end
      end
    end
  end
end;

o~~~~~~~~~o~~~~~~~~~o~~~~~~~~~o~~~~~~~~~o~~~~~~~~~o