[Inquiry] Re: Theme One Program

[Jon Awbrey]

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

TOP.  Note 2

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 order (this: idea): idea;
var here, flag, menu, venu: idea;

function sort (this: idea): idea;
var here, there: idea;
begin
 here := nil;
 if this <> nil then
  begin
   here := this;  there := this;
   repeat
    with there^ do
     begin
      if sign = links then on := sort (on);
      if here^.code < by^.code then here := by;
      there := by
     end
   until there = this
  end;
 sort := here
end;

function resort (thus, that, this: idea): idea;
begin
 resort := this;
 if thus <> nil then with thus^ do on := sort (on);
 if that <> nil then with that^ do on := sort (on)
end;

function free (this: idea): idea;
begin
 free := divert (this, covert (nigh (this), this))
end;

function find (mark: char;
               this: idea): idea;
var here, there: idea;
begin
 here := nil;
 if this <> nil then
  begin
   there := this;
   repeat here := apt (mark, there);
    there := next (there)
   until (here <> nil) or (there = this)
  end;
 find := here
end;

function fore (this: idea): idea;
var here: idea;
begin
 here := nil;
 if this <> nil then
  begin
   here := this;
   repeat here := next (here)
    until next (here) = this
  end;
 fore := here
end;

function rise (this: idea): idea;
var here: idea;
begin
 here := nil;
 if this <> nil then
  begin
   here := this;
   repeat here := fore (here)
    until crest (here) <> nil
  end;
 rise := here
end;

function fall (this: idea): idea;
var here: idea;
begin
 here := nil;
 if this <> nil then
  begin
   here := this;
   repeat here := next (here)
    until crest (here) <> nil
  end;
 fall := here
end;

function prep (mark: char;
               this: idea): idea;
var here, there, where: idea;
begin
 here := nil;
 if this <> nil then
  begin
   there := this;
   repeat
    where := next (there);
    here := divert (apt (mark, where), there);
    there := where
   until (here <> nil) or (there = this)
  end;
 prep := here
end;

function last (this: idea): idea;
begin
 last := prep (right, this)
end;

function suit (this: idea): idea;
begin
 suit := find (right, this)
end;

function coup (this: idea): idea;
begin
 coup := next (suit (this))
end;

function stem (this: idea): idea;
begin
 stem := trip (suit (this))
end;

function sequel (this: idea): idea;
begin
 sequel := suit (trip (this))
end;

function coupon (this: idea): idea;
begin
 coupon := coup (trip (this))
end;

function knap (this: idea): idea;
begin
 knap := equity (next (this), rest (this))
end;

function knot (this: idea): idea;
begin
 knot := equity (this, equity (fore (suit (this)), next (suit (this))))
end;

function respect (this: idea): idea;
begin
 respect := divert (ante (bank (this)), this)
end;

function suspect (this: idea): idea;
begin
 suspect := divert (knot (respect (coupon (lief (this)))), this)
end;

function aspect (this: idea): idea;
var here: idea;
begin
 here := nil;
 if this <> nil then
  if respect (this) <> nil then here := this
   else if suspect (this) <> nil then here := this;
 aspect := here
end;

function apse (that, this: idea): idea;
begin
 apse := divert (equity (ante (that), ante (this)), this)
end;

function sape (that, this: idea): idea;
var here: idea;
begin
 here := nil;
 if this <> nil then
  if atom (that) <> nil then here := rapt (that, this)
   else if bank (that) <> nil then here := apse (that, this);
 sape := here
end;

function pase (that, this: idea): idea;
begin
 pase :=
  divert (apse (
  coupon (suspect (that)),
  coupon (suspect (this))), this)
end;

function apes (that, this: idea): idea;
var here: idea;
begin
 here := nil;
 if this <> nil then
  if sape (that, this) <> nil then here := this
   else if pase (that, this) <> nil then here := this;
 apes := here
end;

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

function axil (this: idea): idea;
var here: idea;
begin
 here := nil;
 if respect (this) <> nil then
  begin
   here := covert (equity (fore (this), next (this)), this);
   if here = nil then here := suspect (stem (this))
  end;
 axil := here
end;

function grasp (this: idea): idea;
var here: idea;
begin
 here := nil;
 if this <> nil then
  if grain (this) <> nil then here := this
   else if suspect (this) <> nil then here := this;
 grasp := here
end;

function fret (this: idea): idea;
var here: idea;
begin
 here := nil;
 if lief (this) <> nil then
  if suspect (this) = nil then here := this;
 fret := here
end;

function deal (this: idea): idea;
var here: idea;
begin
 here := nil;
 if this <> nil then
  if glyph (this) <> nil then
   if fret (this) <> nil then here := trip (this)
    else here := next (this);
 deal := here
end;

function lode (this: idea): idea;
var here: idea;
begin
 here := nil;
 if this <> nil then
  if gram (this) <> nil then here := this
   else if suspect (this) <> nil then here := this;
 lode := here
end;

function lade (this: idea): idea;
var here, there: idea;
begin
 here := nil;
 if this <> nil then
  begin
   there := this;
   repeat there := fore (there);
    here := lode (there)
   until (here <> nil) or (there = this)
  end;
 lade := here
end;

function lead (this: idea): idea;
begin
 lead := lade (upon (grasp (this), stem (this), this))
end;

function joss (this: idea): idea;
var here: idea;
begin
 here := nil;
 if this <> nil then
  if grasp (this) <> nil then here := jog (stem (this))
   else here := this;
 joss := here
end;

function jolt (this: idea): idea;
begin
 jolt := jog (lade (joss (this)))
end;

function graft (that, this: idea): idea;
var here: idea;
begin
 here := nil;
 if this = nil then here := that
  else
   begin
    if that <> nil then
     begin
      here := that^.by;
      that^.by := this^.by;
      this^.by := here
     end;
    here := this
   end;
 graft := here
end;

function pinch (this: idea): idea;
var here, there: idea;
begin
 here := nil;
 if this <> nil then
  begin
   there := beset (fore (this), next (this));
   here := cog (this)
  end;
 pinch := here
end;

function switch: idea;
var here: idea;
begin
 here := bud (links);
 with here^ do
  begin
   on := peg (right, nil, nil, here, nil, 0);
   on^.by := on;
   here := on
  end;
 switch := here
end;

function stitch: idea;
begin
 stitch := trip (switch)
end;

function splice: idea;
begin
 splice := bud (comma)
end;

function work (this: idea): idea;
var here: idea;
begin
 here := nil;
 if this <> nil then
  if lief (this) <> nil then here := this
   else if ante (this) <> nil then here := this;
 work := here
end;

function ease (this: idea): idea;
var here, there, where: idea;
begin
 here := nil;
 if rest (this) <> nil then
  begin
   there := this;
   repeat there := next (there);
    where := work (there)
   until (where <> nil) or (there = this);
   here := covert (where, this)
  end;
 ease := here
end;

function edge (this: idea): idea;
begin
 edge := divert (ease (sequel (lief (this))), this)
end;

function clue (that, this: idea): idea;
begin
 clue := graft (nub (that), this)
end;

function recall (var thou: text;
                     this: idea): idea;
forward;

function hark (var thou: text;
                   this: idea): idea;
var here: idea;
begin
 hark := nil;
 if this <> nil then
  begin
   here := next (this);
   repeat here := next (here);
    if ante (here) = nil then here := part (thou, here)
     else here := obvert (here, recall (thou, ante (here)))
   until here = this;
   this := recycle (this)
  end
end;

function back (this: idea): idea;
var here, there: idea;
begin
 here := nil;
 if this <> nil then
  begin
   there := this;
   repeat there := lead (there);
    here := clue (there, here)
   until there = nil
  end;
 back := here
end;

function recall { (var thou: text;
                       this: idea): idea };
var here: idea;
begin
 recall := this;
 if this <> nil then
  if tare (this) <> nil then here := hark (thou, back (this))
   else if bank (this) = nil then here := part (thou, this)
    else here := recall (thou, ante (this))
end;

function call (this: idea): idea;
begin
 call := obvert (this, recall (con, ante (this)))
end;

function recant (var thou: text;
                     this: idea): idea;
begin
 recant :=
    pass (thou, blank + right,
  recall (thou, coupon (
    pass (thou, links, this))))
end;

function state (var thou: text;
                    this: idea): idea;
var here: idea;
begin
 state := this;
 if this <> nil then
  if respect (this) <> nil then here := recall (thou, this)
   else if suspect (this) <> nil then here := recant (thou, this)
end;

function claim (this: idea): idea;
begin
 claim := state (con, this)
end;

function recount (var thou: text;
                      this: idea): idea;
var here: idea;

function harp (var thou: text;
                   this: idea): idea;
begin
 harp := obvert (this, hark (thou, nigh (this)))
end;

function beck (this: idea): idea;
var here, there, where: idea;
begin
 here := nil;
 if this <> nil then
  begin
   here := nib;
   there := nil;  where := this;
   repeat where := lead (where);
    there := clue (where, there);
    here := jog (upset (here, there))
   until where = nil
  end;
 beck := here
end;

begin { recount }
 here := nil;
 if this <> nil then
  if tare (this) <> nil then here := harp (thou, beck (this))
   else if bank (this) = nil then here := part (thou, this)
    else here := recount (thou, ante (this));
 recount := here
end;

function counter (var thou: text;
                      this: idea): idea;
begin
 counter :=
     pass (thou, blank + right,
  recount (thou, coupon (
     pass (thou, links, this))))
end;

function issue (var thou: text;
                    span: numb;
                    this: idea): idea;
var here: idea;
begin
 issue := this;
 if this <> nil then
  if respect (this) <> nil then
   here := skip (thou, span - reck (recount (thou, this)), this)
  else if suspect (this) <> nil then
   here := skip (thou, span - reck (counter (thou, this)) - 3, this)
end;

function list (this: idea;
               mark: char): idea;
begin
 list := graft (this, bud (mark))
end;

function roll (this, that: idea): idea;
begin
 roll := graft (this, nub (that))
end;

function image (this: idea): idea;
begin
 image := stem (graft (switch, this))
end;

function token (this: idea): idea;
var here: idea;
begin
 here := nil;
 if this <> nil then here := bud (arch (this));
 token := here
end;

function tally (this: idea): idea;
begin
 tally := inset (token (this), reck (this))
end;

function gist (this: idea): idea;
begin
 gist := asset (token (this), ante (this))
end;

function gage (this: idea): idea;
begin
 gage := gist (gram (this))
end;

function gate (this: idea): idea;
begin
 gate := image (gage (coupon (this)))
end;

function gauge (this: idea): idea;
var here: idea;
begin
 here := nil;
 if this <> nil then
  if gram (this) <> nil then here := gist (this)
   else if suspect (this) <> nil then here := gate (this);
 gauge := here
end;

function vest (this: idea): idea;
begin
 vest := divert (ante (bank (this)), this)
end;

function test (this: idea): idea;
var here: idea;
begin
 here := nil;
 if this <> nil then
  if cope (this) <> nil then here := this
   else here := vest (this);
 test := here
end;

function pend (this: idea): idea;
begin
 pend := inset (gist (this), reck (this))
end;

function mend (this: idea): idea;
begin
 mend := pend (cope (this))
end;

function vend (this: idea): idea;
begin
 vend := pend (vest (this))
end;

function tend (this: idea): idea;
begin
 tend := pend (test (this))
end;

function buff (line: info): idea;
var here: idea;
    i, n: numb;
begin
 here := nil;  n := length (line);
 if n > 0 then
  begin
   here := nib;
   for i := 1 to n do here := list (here, line[i])
  end;
 buff := here
end;

function brush (row, col: numb;
                    this: idea): idea;
var here: idea;
begin
 brush := this;
 if this <> nil then
  begin
   here := next (this);
   repeat here := part (con, at (row, anew (col), next (here)))
    until here = this
  end
end;

function wend (that, this: idea): idea;
var here: idea;
begin
 wend := this;
 if this <> nil then
  begin
   if that = nil then here := onset (this, this)
    else here := onset (that, onset (this, trip (that)));
   here := asset (ante (this), this)
  end
end;

function past (this: idea): idea;
begin
 past := ante (ante (this))
end;

function plot (this: idea): idea;
begin
 plot := wend (past (this), this)
end;

function wink (var thou: text): char;
begin
 wink := tap (thou);
 wink := blank
end;

function heed (var thou: text): char;
var mark: char;
begin
 mark := tap (thou);
 case mark of
  enter: mark := wink (thou);
  ender: mark := blank
 end;
 heed := mark
end;

function bulk (mark: char): boolean;
begin
 bulk := mark in [blank, nul]
end;

function tack (mark: char;
               this: idea): idea;
var here: idea;
begin
 here := nil;
 if lief (this) <> nil then
  begin
   here := sequel (this);
   if not bulk (mark) then here := find (mark, here)
  end
 else if cope (this) <> nil then
  if bulk (mark) then here := this;
 tack := here
end;

function spot (var thou: text;
                   this: idea): idea;
var here: idea;
begin
 here := nil;
 if this <> nil then
  begin
   here := this;
   repeat here := tack (heed (thou), next (here))
    until (crest (here) <> nil) or (here = nil);
   if here = nil then here := critique ('lit', this)
  end;
 spot := here
end;

function match (that, this: idea): idea;
var here, there: idea;
begin
 there := nil;
 if this <> nil then if that <> nil then
  begin
   here := next (next (this));
   there := tack (arch (here), that);
   while glyph (there) <> nil do
    begin
     here := next (here);
     there := tack (arch (here), next (there))
    end
  end;
 match := there
end;

function stock: idea;
begin
 stock := image (stitch)
end;

function clave (var thou: text;
                    this: idea): idea;
var here: idea;
    name: info;
begin
 here := nil;  readln (name);
 if name = empty then here := stock
  else
   begin
    assign (thou, name);  reset (thou)
   end;
 clave := here
end;

function clepe (var thou: text;
                    this: idea): idea;
var name: info;
begin
 clepe := this;  readln (name);
 if name = empty then name := 'con';
 assign (thou, name);  rewrite (thou)
end;

function compt (var thou: text;
                    this: idea): idea;
begin
 compt := this;  close (thou)
end;

function spell (var thou: text): idea;
var here: idea;
    mark: char;
begin
 here := nil;
 repeat mark := tap (thou);
  case mark of
   links: here := trip (graft (here, inset (stitch, nip (thou))));
   right: if rest (next (here)) <> nil then
           here := trip (inset (next (here), nip (thou)))
          else here := critique ('lex', here);
   enter: mark := tap (thou);
   ender:
   else   here := inset (list (here, mark), nip (thou))
  end
 until mark = ender;
 spell := here
end;

function fetch (this: idea): idea;
var here: idea;
    thou: text;
begin
 here := nil;
 if this = nil then
  begin
   if prompt ('read lex file') <> nil then
    begin
     here := clave (thou, this);
     if here = nil then
      here := compt (thou, spell (thou))
    end
  end;
 fetch := here
end;

function chart (var thou: text;
                    thus: mode;
                    this: idea): idea;
var here: idea;
    mark: char;
begin
 here := nil;
 repeat mark := tap (thou);
  case mark of
   links: here := trip (graft (here, inset (stitch, knab (thou, thus))));
   right: if rest (next (here)) <> nil then
           here := trip (inset (next (here), knab (thou, thus)))
          else here := critique ('par', here);
   comma: here := graft (here, inset (splice, knab (thou, thus)));
   enter: mark := tap (thou);
   blank, ender:
   else here := inset (plot (roll (here, spot (thou, tack (mark, this)))),
                       knab (thou, thus))
  end
 until mark = ender;
 chart := here
end;

function frame (term: info;
                this: idea): idea;
var here: idea;
    thou: text;
begin
 here := nil;
 if this <> nil then
  if prompt ('read '+ term +' file') <> nil then
   begin
    here := clave (thou, here);
    if here = nil then
     here := compt (thou, chart (thou, kind (term), this))
   end;
 frame := here
end;

function stage (this: idea): idea;
var here, there: idea;
begin
 here := nil;
 there := fetch (nil);
 if there <> nil then
  begin
   there := graft (switch, sort (there));
   here := frame ('lit', there);
   if here <> nil then here := graft (there, sort (here))
  end;
 stage := here
end;

function clip (var thou: text;
                   this: idea): idea;
forward;

function post (var thou: text;
                   this: idea): idea;
var here: idea;
begin
 post := this;
 if bank (this) <> nil then here := recall (thou, ante (this));
 here := pose (thou, this);
 if lief (this) <> nil then here := clip (thou, sequel (this))
end;

function clip { (var thou: text;
                     this: idea): idea };
var here: idea;
begin
 clip := this;
 if this <> nil then
  begin
   here := this;
   repeat here := post (thou, next (here))
    until here = this
  end
end;

function save (this: idea): idea;
var thou: text;
begin
 save := turn (compt (thou, clip (thou, clepe (thou, this))))
end;

function show (this: idea): idea;
begin
 show := clip (con, this)
end;

function tell (this: idea): idea;
begin
 tell := next (show (fore (this)))
end;

function site (var thou: text;
                   this: idea): idea;
var here: idea;
begin
 site := this;
 if this <> nil then
  if atom (this) <> nil then here := part (thou, this)
   else if ante (this) <> nil then
    begin
     if crest (this) <> nil then here := pass (thou, quote, this);
     here := recall (thou, ante (this))
    end
end;

function toss (var thou: text;
             that, this: idea): idea;
begin
 toss := this;  write (thou, seg (that^) : 8, ofs (that^) : 2)
end;

function dump (this: idea): idea;
var here: idea;
begin
 dump := this;
 if this <> nil then
  begin
   here := this;
   repeat here := next (here);
    here :=
     turn (
     site (con, skip (con, 4, score (con, 8,
     toss (con, next (here),
     toss (con, trip (here),
     toss (con, ante (here),
     pass (con, arch (here),  skip (con, 4,
     toss (con, here, here))))))))));
    if lief (here) <> nil then
     here := obvert (here, dump (sequel (here)))
   until here = this
  end
end;

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