mudlle/obj.mud at master · MUME/mudlle · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
/*
 * Copyright (c) 1993-2012 David Gay
 * All rights reserved.
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose, without fee, and without written agreement is hereby granted,
 * provided that the above copyright notice and the following two paragraphs
 * appear in all copies of this software.
 *
 * IN NO EVENT SHALL DAVID GAY BE LIABLE TO ANY PARTY FOR DIRECT, INDIRECT,
 * SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OF
 * THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF DAVID GAY HAVE BEEN ADVISED OF
 * THE POSSIBILITY OF SUCH DAMAGE.
 *
 * DAVID GAY SPECIFICALLY DISCLAIM ANY WARRANTIES, INCLUDING, BUT NOT LIMITED
 * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
 * PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS ON AN "AS IS" BASIS, AND DAVID
 * GAY HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES,
 * ENHANCEMENTS, OR MODIFICATIONS.
 */

[
  | fname |

  fname = fn (prelinked_fn)
    format("%s at %s:%s",
	   if (prelinked_fn[2] != null) prelinked_fn[2] else "<fn>",
	   prelinked_fn[3], prelinked_fn[4]);

  mc:obj_find = fn (prelinked_fn, name)
    [
      | csts, info, see_global, done |

      done = false;

      foreach(fn (off)
	        if (!done && string_icmp(car(off), name) == 0)
	          [
		    display("constant "); display(fname(prelinked_fn));
		    newline();
		    done = true;
		  ],
	      prelinked_fn[10]);

      if (!done)
	[
	  see_global = fn (off)
	    if (!done && string_icmp(car(off), name) == 0)
	      [
		display(fname(prelinked_fn));
		newline();
		done = true;
	      ];

	  foreach(see_global, prelinked_fn[9]);
	  foreach(see_global, prelinked_fn[8]);
	];

      foreach(fn (off) mc:obj_find(car(off), name), prelinked_fn[5]);

    ];

  mc:obj_global_write = fn (prelinked_fn)
    [
      | gw |

      gw = fn (pfn)
	[
	  if (pfn[9] != null)
	    [
	      dformat("%s: %s\n", fname(pfn),
                      concat_words(mapcar(car, pfn[9]), " "));
	    ];
	  foreach(fn (off) gw(car(off)), pfn[5]);
	];
      // Ignore top-level assigns
      foreach(fn (off) gw(car(off)), prelinked_fn[5]);
    ];

  mc:obj_find_names = fn (fnames, vname)
    foreach(fn (fname)
	    [
	      display(fname); newline();
	      mc:obj_find(load_data(fname), vname)
	    ], fnames);

  mc:obj_names_op = fn (fnames, op)
    foreach(fn (fname)
	    [
	      display(fname); newline();
	      op(load_data(fname))
	    ], fnames);

  mc:size = fn (prelinked_fn)
    string_length(prelinked_fn[0]) +
      lreduce(fn (x, sum) sum + mc:size(car(x)), 0, prelinked_fn[5]);
];