Unit tests for Literate Haskell

[ohcount] / test / src_dir / knuth_web.web

% Sample WEB file, obtained with excerpts from mpost.web\r
\r
@* \[1] Introduction.\r
This is \MP, a graphics-language processor based on D. E. Knuth's \MF.\r
The \PASCAL\ program that follows defines a standard version\r
@:PASCAL}{\PASCAL@>\r
of \MP\ that is designed to be highly portable so that identical output\r
will be obtainable on a great variety of computers.\r
\r
@ The present implementation is a preliminary version, but the possibilities\r
for new features are limited by the desire to remain as nearly compatible\r
with \MF\ as possible.\r
\r
@d banner=='This is MetaPost, Version 0.641' {printed when \MP\ starts}\r
\r
@ Actually the heading shown here is not quite normal: The |program| line\r
does not mention any |output| file, because \ph\ would ask the \MP\ user\r
to specify a file name if |output| were specified here.\r
@^system dependencies@>\r
\r
@d mtype==t@&y@&p@&e {this is a \.{WEB} coding trick:}\r
@f mtype==type {`\&{mtype}' will be equivalent to `\&{type}'}\r
@f type==true {but `|type|' will not be treated as a reserved word}\r
\r
@p @t\4@>@<Compiler directives@>@/\r
program MP; {all file names are defined dynamically}\r
label @<Labels in the outer block@>@/\r
const @<Constants in the outer block@>@/\r
mtype @<Types in the outer block@>@/\r
var @<Global variables@>@/\r
@#\r
procedure initialize; {this procedure gets things started properly}\r
  var @<Local variables for initialization@>@/\r
  begin @<Set initial values of key variables@>@/\r
  end;@#\r
@t\4@>@<Basic printing procedures@>@/\r
@t\4@>@<Error handling procedures@>@/\r
\r
@<Labels in the out...@>=\r
start_of_MP@t\hskip-2pt@>, end_of_MP@t\hskip-2pt@>,@,final_end;\r
  {key control points}\r
\r
@ Some of the code below is intended to be used only when diagnosing the\r
strange behavior that sometimes occurs when \MP\ is being installed or\r
when system wizards are fooling around with \MP\ without quite knowing\r
what they are doing. Such code will not normally be compiled; it is\r
delimited by the codewords `$|debug|\ldots|gubed|$', with apologies\r
to people who wish to preserve the purity of English.\r
\r
Similarly, there is some conditional code delimited by\r
`$|stat|\ldots|tats|$' that is intended for use when statistics are to be\r
kept about \MP's memory usage.\r
@^debugging@>\r
\r
@d debug==@{ {change this to `$\\{debug}\equiv\null$' when debugging}\r
@d gubed==@t@>@} {change this to `$\\{gubed}\equiv\null$' when debugging}\r
@f debug==begin\r
@f gubed==end\r
@#\r
@d stat==@{ {change this to `$\\{stat}\equiv\null$' when gathering\r
  usage statistics}\r
@d tats==@t@>@} {change this to `$\\{tats}\equiv\null$' when gathering\r
  usage statistics}\r
@f stat==begin\r
@f tats==end\r
\r
@ If the first character of a \PASCAL\ comment is a dollar sign,\r
\ph\ treats the comment as a list of ``compiler directives'' that will\r
affect the translation of this program into machine language.  The\r
directives shown below specify full checking and inclusion of the \PASCAL\\r
debugger when \MP\ is being debugged, but they cause range checking and other\r
redundant code to be eliminated when the production system is being generated.\r
Arithmetic overflow will be detected in all cases.\r
@^system dependencies@>\r
@^Overflow in arithmetic@>\r
\r
@<Compiler directives@>=\r
@{@&$C-,A+,D-@} {no range check, catch arithmetic overflow, no debug overhead}\r
@!debug @{@&$C+,D+@}@+ gubed {but turn everything on when debugging}\r
\r
@ The following parameters can be changed at compile time to extend or\r
reduce \MP's capacity. They may have different values in \.{INIMP} and\r
in production versions of \MP.\r
@.INIMP@>\r
@^system dependencies@>\r
\r
@<Constants...@>=\r
@!mem_max=30000; {greatest index in \MP's internal |mem| array;\r
  must be strictly less than |max_halfword|;\r
  must be equal to |mem_top| in \.{INIMP}, otherwise |>=mem_top|}\r
@!max_internal=100; {maximum number of internal quantities}\r
@!buf_size=500; {maximum number of characters simultaneously present in\r
  current lines of open files; must not exceed |max_halfword|}\r
\r
@ Here are some macros for common programming idioms.\r
\r
@d incr(#) == #:=#+1 {increase a variable by unity}\r
@d decr(#) == #:=#-1 {decrease a variable by unity}\r
@d negate(#) == #:=-# {change the sign of a variable}\r
@d double(#) == #:=#+# {multiply a variable by two}\r
@d loop == @+ while true do@+ {repeat over and over until a |goto| happens}\r
@f loop == xclause\r
  {\.{WEB}'s |xclause| acts like `\ignorespaces|while true do|\unskip'}\r
@d do_nothing == {empty statement}\r
@d return == goto exit {terminate a procedure call}\r
@f return == nil {\.{WEB} will henceforth say |return| instead of \\{return}}\r
\r
@* \[2] The character set.\r
In order to make \MP\ readily portable to a wide variety of\r
computers, all of its input text is converted to an internal eight-bit\r
code that includes standard ASCII, the ``American Standard Code for\r
Information Interchange.''  This conversion is done immediately when each\r
character is read in. Conversely, characters are converted from ASCII to\r
the user's external representation just before they are output to a\r
text file.\r
@^ASCII code@>\r
\r
@ Since we are assuming that our \PASCAL\ system is able to read and\r
write the visible characters of standard ASCII (although not\r
necessarily using the ASCII codes to represent them), the following\r
assignment statements initialize the standard part of the |xchr| array\r
properly, without needing any system-dependent changes. On the other\r
hand, it is possible to implement \MP\ with less complete character\r
sets, and in such cases it will be necessary to change something here.\r
@^system dependencies@>\r
\r
@<Set init...@>=\r
xchr[@'40]:=' ';\r
xchr[@'47]:='''';@/\r
xchr[@'100]:='@@';\r
xchr[@'134]:='\';\r
\r
@ We need a special routine to read the first line of \MP\ input from\r
the user's terminal. This line is different because it is read before we\r
have opened the transcript file; there is sort of a ``chicken and\r
egg'' problem here. If the user types `\.{input cmr10}' on the first\r
line, or if some macro invoked by that line does such an \.{input},\r
the transcript file will be named `\.{cmr10.log}'; but if no \.{input}\r
commands are performed during the first line of terminal input, the transcript\r
file will acquire its default name `\.{mpout.log}'. (The transcript file\r
will not contain error messages generated by the first line before the\r
first \.{input} command.)\r
\r
The first line is even more special if we are lucky enough to have an operating\r
system that treats \MP\ differently from a run-of-the-mill \PASCAL\ object\r
program. It's nice to let the user start running a \MP\ job by typing\r
a command line like `\.{MP cmr10}'; in such a case, \MP\ will operate\r
as if the first line of input were `\.{cmr10}', i.e., the first line will\r
consist of the remainder of the command line, after the part that invoked \MP.\r
\r
The first line is special also because it may be read before \MP\ has\r
input a mem file. In such cases, normal error messages cannot yet\r
be given. The following code uses concepts that will be explained later.\r
\r
@<Report overflow of the input buffer, and abort@>=\r
if mem_ident=0 then\r
  begin write_ln(term_out,'Buffer size exceeded!'); goto final_end;\r
@.Buffer size exceeded@>\r
  end\r
else begin cur_input.loc_field:=first; cur_input.limit_field:=last-1;\r
  overflow("buffer size",buf_size);\r
@:MetaPost capacity exceeded buffer size}{\quad buffer size@>\r
  end\r
\r
@ Different systems have different ways to get started. But regardless of\r
what conventions are adopted, the routine that initializes the terminal\r
should satisfy the following specifications:\r
\r
\yskip\textindent{1)}It should open file |term_in| for input from the\r
  terminal. (The file |term_out| will already be open for output to the\r
  terminal.)\r
\r
\textindent{2)}If the user has given a command line, this line should be\r
  considered the first line of terminal input. Otherwise the\r
  user should be prompted with `\.{**}', and the first line of input\r
  should be whatever is typed in response.\r
\r
\textindent{3)}The first line of input, which might or might not be a\r
  command line, should appear in locations |first| to |last-1| of the\r
  |buffer| array.\r
\r
\textindent{4)}The global variable |loc| should be set so that the\r
  character to be read next by \MP\ is in |buffer[loc]|. This\r
  character should not be blank, and we should have |loc<last|.\r
\r
\yskip\noindent(It may be necessary to prompt the user several times\r
before a non-blank line comes in. The prompt is `\.{**}' instead of the\r
later `\.*' because the meaning is slightly different: `\.{input}' need\r
not be typed immediately after~`\.{**}'.)\r
\r
@d loc==cur_input.loc_field {location of first unread character in |buffer|}\r
\r
@ Strings are created by appending character codes to |str_pool|.\r
The |append_char| macro, defined here, does not check to see if the\r
value of |pool_ptr| has gotten too high; this test is supposed to be\r
made before |append_char| is used.\r
\r
@ @<Declare the procedure called |do_compaction|@>=\r
procedure do_compaction(@!needed:pool_pointer);\r
label done;\r
var @!str_use:str_number; {a count of strings in use}\r
@!r,@!s,@!t:str_number; {strings being manipulated}\r
@!p,@!q:pool_pointer; {destination and source for copying string characters}\r
begin @<Advance |last_fixed_str| as far as possible and set |str_use|@>;\r
r:=last_fixed_str;\r
s:=next_str[r];\r
p:=str_start[s];\r
while s<>str_ptr do\r
  begin while str_ref[s]=0 do\r
    @<Advance |s| and add the old |s| to the list of free string numbers;\r
      then |goto done| if |s=str_ptr|@>;\r
  r:=s; s:=next_str[s];\r
  incr(str_use);\r
  @<Move string |r| back so that |str_start[r]=p|; make |p| the location\r
    after the end of the string@>;\r
  end;\r
done: @<Move the current string back so that it starts at |p|@>;\r
if needed<pool_size then\r
  @<Make sure that there is room for another string with |needed| characters@>;\r
stat @<Account for the compaction and make sure the statistics agree with the\r
    global versions@>;\r
tats@;\r
strs_used_up:=str_use;\r
end;\r
\r
@ @<Handle the test for eastward directions when $y_1y_3=y_2^2$;\r
    either |goto found| or |goto done|@>=\r
begin if ab_vs_cd(y1,y2,0,0)<0 then\r
  begin t:=make_fraction(y1,y1-y2);\r
  x1:=t_of_the_way(x1)(x2);\r
  x2:=t_of_the_way(x2)(x3);\r
  if t_of_the_way(x1)(x2)>=0 then we_found_it;\r
  end\r
else if y3=0 then\r
  if y1=0 then\r
    @<Exit to |found| if the derivative $B(x_1,x_2,x_3;t)$ becomes |>=0|@>\r
  else if x3>=0 then\r
    begin tt:=unity; goto found;\r
    end;\r
goto done;\r
end\r
\r
@ At this point we know that the derivative of |y(t)| is identically zero,\r
and that |x1<0|; but either |x2>=0| or |x3>=0|, so there's some hope of\r
traveling east.\r
\r
@ Now this is really it: \MP\ starts and ends here.\r
\r
The initial test involving |ready_already| should be deleted if the\r
\PASCAL\ runtime system is smart enough to detect such a ``mistake.''\r
@^system dependencies@>\r
\r
@p begin @!{|start_here|}\r
history:=fatal_error_stop; {in case we quit during initialization}\r
t_open_out; {open the terminal for output}\r
if ready_already=314159 then goto start_of_MP;\r
@<Check the ``constant'' values...@>@;\r
if bad>0 then\r
  begin wterm_ln('Ouch---my internal constants have been clobbered!',\r
    '---case ',bad:1);\r
@.Ouch...clobbered@>\r
  goto final_end;\r
  end;\r
initialize; {set global variables to their starting values}\r
@!init if not get_strings_started then goto final_end;\r
init_tab; {initialize the tables}\r
init_prim; {call |primitive| for each primitive}\r
init_str_use:=str_ptr; init_pool_ptr:=pool_ptr;@/\r
max_str_ptr:=str_ptr; max_pool_ptr:=pool_ptr;\r
fix_date_and_time;\r
tini@/\r
ready_already:=314159;\r
start_of_MP: @<Initialize the output routines@>;\r
@<Get the first line of input and prepare to start@>;\r
history:=spotless; {ready to go!}\r
if start_sym>0 then {insert the `\&{everyjob}' symbol}\r
  begin cur_sym:=start_sym; back_input;\r
  end;\r
main_control; {come to life}\r
final_cleanup; {prepare for death}\r
end_of_MP: close_files_and_terminate;\r
final_end: ready_already:=0;\r
end.\r
\r
@ Here we do whatever is needed to complete \MP's job gracefully on the\r
local operating system. The code here might come into play after a fatal\r
error; it must therefore consist entirely of ``safe'' operations that\r
cannot produce error messages. For example, it would be a mistake to call\r
|str_room| or |make_string| at this time, because a call on |overflow|\r
might lead to an infinite loop.\r
@^system dependencies@>\r
\r