Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] View of /bugs/branches/smlnj/bugs.0401-0600
ViewVC logotype

View of /bugs/branches/smlnj/bugs.0401-0600

Parent Directory Parent Directory | Revision Log Revision Log


Revision 945 - (download) (annotate)
Thu Oct 4 13:38:32 2001 UTC (17 years, 8 months ago)
File size: 458654 byte(s)
This commit was manufactured by cvs2svn to create branch 'smlnj'.
Number: 401
Title: Imperative types in SML/NJ 0.66
Keywords: types, weak types, polymorphism
Submitter: Dave Berry <db@lfcs.edinburgh.ac.uk>
Date: 2/14/91 
Version: 0.66
System:
Severity: 
Problem: 
The following program compiles under Poly/ML 1.86, but fails to compile
under SML/NJ 0.66.


fun create (x:int) (y:'_a) :'_a Array.array = Array.array (x, y)

type ('a,'b) table = ('a*int*'b) list Array.array

val defaultSize = 97

fun createDefault (sample'value :'_a) :(string, '_a) table =
  let val mt = [] : (string * int * '_a) list
  in create defaultSize mt
  end


It will compile if Array.array is used directly in place of the curried
version.  It will also compile if createDefault is given an extra parameter,
either before or after the existing one.

This is the simplest example I've run across of SML/NJ failing to type
correct SML use of imperative types. It's fairly simple in this case -
it only took me a day to get the case this simple - but I've come across
at least one other example that I've just given up on.

I remember Dave MacQueen and mads Tofte discussing a bug in the SML/NJ
algorithm at the Edinburgh Workshop.  Is there any chance of a fix?

Dave.


From: jhr@cs.cornell.edu (John Reppy)
This problem was pointed out by Jim O'Toole.  Anyway, it was fixed
in 0.67:

  Standard ML of New Jersey, Version 0.68-JHR, January 25, 1991
  val it = () : unit
  - fun create (x:int) (y:'_a) :'_a Array.array = Array.array (x, y)
  = type ('a,'b) table = ('a*int*'b) list Array.array
  = val defaultSize = 97
  = fun createDefault (sample'value :'_a) :(string, '_a) table =
  = let val mt = [] : (string * int * '_a) list
  = in create defaultSize mt
  = end;
  val create = fn : int -> '1a -> '1a array
  type ('a,'b)  table = ('a * int * 'b) list array
  val defaultSize = 97 : int
  val createDefault = fn : '1a -> (string,'1a) table
  - 
Status: fixed in 0.67
---------------------------------------------------------------------------
Number: 402
Title: local non-declarations
Keywords: 
Submitter:      Bernard Berthomieu (bernard@laas.laas.fr)
Date:		30/1/90
Version:        0.66
System:         SUN Sparstation 1+, SunOS 4.0.3c
Severity:       minor
Problem:        some declarations not accepted
Code:           local val x = 5 in 20 + x end;
Transcript:     - local val x = 5 in 20 + x end;
		std_in:1.21 Error: syntax error found at INT
Comments:	Not sure this is a bug, but the SML documents are not clear
		about this. According to my interpretation of the standard
		grammar, this declaration should be equivalent to the following:
		- local val x = 5 in val it = 20 + x end;
		val it = 25 : int
Fix:  expressions are considered as declarations ONLY at top level.
Status: not a bug
---------------------------------------------------------------------------
Number: 403
Title: 0.0/0.0 not properly handled on Sparc
Keywords: 
Submitter:      Bernard Berthomieu (bernard@laas.laas.fr)
Date:		30/1/90
Version:        0.66
System:         SUN Sparstation 1+, SunOS 4.0.3c
Severity:       minor
Problem:        0.0/0.0 not properly handled
Code:           0.0/0.0
Transcript:     - 0.0/0.0;
		strange floating point error        (* and sml exits *)
Comments:	0.0/0.0 is generally considered in implementations 
		of reals as an "invalid operation" rather than a "division
		by zero" (exception code FPE_FLTOPERR_TRAP on SUNs OS 4.0).
		I did not checked the effect of 0.0/0.0 on other targets
		than SUN 4s, but it might have strange effects too;

Submitter:            Josh Hodas  (hodas@cs.hmc.edu)
Date:                 3/6/95
System(s) and Version: ???
SML/NJ Version:       0.93
Machine:              Sparc 1000 / SunOs 5.3
Severity:             minor
Problem:              The 0.0/0.0 bug that generates "strange floating point
                      error 0x7" and exits to unix, which was (according to
                      the master bugs file) fixed in 0.68 has returned.

Code:                 0.0/0.0;
Transcript:

Standard ML of New Jersey, Version 0.93, February 15, 1993
val it = () : unit
- 0.0/0.0;
strange floating point error, 0x7
Owner: John
Status: obsolete [new basis]
---------------------------------------------------------------------------
Number: 404
Title: std_out not flushed on read from std_in
Keywords: 
Submitter:    Kim Dam Petersen  (kimdam@sun.tfl.dk)
Date:		6/1/91
Version:        0.66
System:         all
Severity:       minor
Problem:        std_out not flushed on read from std_in
Comments:
 As printing on the standard output and error streams usually are
 flushed automatically I would suggest that this should be part of the
 standard behaviour of these stream.

 It seems that NJ/ML delays output flushing until the computation of a
 top level expression has completed.  As mentioned above flushing
 should be performed immediately.  A temporary solution in NJ/ML is
 to redefine the `output' function, such that the predefined
 `flush_out' is automatically called:

      val output = fn(s,t) => (output(s,t); flush_out s)

 Future call of `output' will print the text immediately.
Status: fixed in 0.71
---------------------------------------------------------------------------
Number: 405
Title: identifiers starting with underscores are incorrectly allowed
Keywords: 
Submitter: Mick Francis (Abstract Hardware)
Date:		8/1/91
Version:        0.66
System:         all
Severity:       minor
Problem:        identifiers starting with underscores are incorrectly allowed
Status: fixed in 0.73
---------------------------------------------------------------------------
Number: 406
Title: funny signatures in 0.71
Keywords: 
Submitter: John Reppy
Date:		8/1/91
Version:        0.71
System:         all
Severity:       minor
Problem:        Array.tabulate and String.chr have wrong types
		in initial environment
Status: fixed in 0.73
---------------------------------------------------------------------------
Number: 407
Title: create_v_v for SPARC
Keywords: 
Submitter:      Juergen Buntrock TUB, jubu@cs.tu-berlin.de 
Date:  9/24/91
Version: 0.73
System:       	sun4c SUNOS 4.1.1 
Severity:       major
Problem:
		The mask is not set in create_v_v (SPARC.prim.s)
		segmentation fault
		in collect_roots in callgc.c
Fix:
diff -c SPARC.prim.s.org SPARC.prim.s

*** SPARC.prim.s.org    Fri Aug 23 20:33:54 1991
--- SPARC.prim.s        Tue Sep 24 19:11:30 1991
***************
*** 476,481 ****
--- 476,483 ----
        nop
  4:
        CONTINUE
+       .word   closmask                /* reg. mask */
+       .word   0

  3:
        add     %g0,0,%g0               /* nop to get PC adjust right */

Status: fixed in 0.74
---------------------------------------------------------------------------
Number: 408
Title: feedback from module system
Keywords: 
Submitter:      tmb@ai.mit.edu
Date:           08/03/91
Version:        0.70
System:         Sun4/OS4.1.1
Severity:       cosmetic, but important

I have been playing around with building functors that abstract
various notions of "iteration", "array", "sequence", and "index"
(ultimately, this will hopefully provide a nicer alternative to the
equivalent data structures in the current SML library).

In general, using the ML module and type system for this seems
straightforward and natural, and I'm much more pleased with the way I
can design this code in SML than with similar code that I have written
in Scheme, CommonLisp, and C++.

However, I have also come across some cosmetic but (to me) important
problems with the NJ/SML module system.

Some of the problems are that the system isn't telling me enough about
the identity of objects to allow me to debug the code without having
to guess much; something analogous to the LispMachine inspector and
mouse sensitivity would ultimately be very useful, but for the time
being, just reporting unique tags for objects instead of "?"  would be
sufficient.

Some of this might also be a question of style, but my ignorance is
partially due to the fact that the only uses of the module system that
I have seen have been rather simple and straightforward (even if they
involve lots of code).

I'd appreciate your feedback.

						Thanks, Thomas.

PS: I can send you the complete code if you are interested, but
it is still more of a sketch or prototype.

= 1 ================================================================

I have a functor which generates iteration constructs for some data
type that it is handed (e.g., it generates "fold", "apply", etc. for
lists and arrays). It is very confusing that the types that the system
reports for the functions generated by this functor involve types of
the form "('a,'b) value" and "('a,'b) index". It would be much better
if the types were reported in their true form.

   signature S = sig type ('a,'b) data end;
   functor F(structure X:S) = struct fun f(x:('a,'b) X.data):('a,'b) X.data = x end;
   structure A = struct type ('a,'b) data = 'b list end;
   structure B = F(structure X=A);

   - B.f([1]);
   val it = [1] : ('a,int) A.data
   -

What I would want is:

   - B.f([1]);
   val it = [1] : int list
   -

Obviously, which form one wants depends on the exact use that a
functor is going to be put to. There should be a mechanism for me to
specify in the type binding which form of reporting I prefer.

= 2 ================================================================

Another problem that I have encountered is that it is nearly
impossible to figure out what goes wrong with complicated functor
applications with the current level of reporting: elements of
intermediate structures are now often only reported as
"?.KeyIndexing.foo", and it isn't helpful if the compiler tells you
that "?.KeyIndexing.foo" is a different type from "?.KeyIndexing.foo".

It would be much more convenient if there was an option to the
compiler that would trace and report functor applications, and if the
printer gave unique identities to structures, even temporary ones.

Something like:

   - use "foo";
   [Applying functor F<10> to structure <1001> giving structure <347> bound to structure T]
   [Applying functor G<11> to structure <66> giving structure <67> bound to structure T.M]
   [Applying functor G<11> to structure <33> giving structure <68> bound to structure T.M]
   - T.i;
   val it = SOMETHING : <11>.my_type;
   -

Printing unique ID's for structures (and, for that matter, for other
objects) shouldn't be hard, and it makes debugging so much easier.

= 3 ================================================================

When writing signatures for functors that generate polymorphic
functions, I seem to have to define types that carry around one type
variable for each polymorphic type, e.g.:

signature BASICACCESS =
    sig
	type ('a,'b) point
	type ('a,'b) value
	type ('a,'b) index
	type ('a,'b) range
	val first: ('a,'b) range -> ('a,'b) index
	val succ: ('a,'b) index -> ('a,'b) index
	val done: ('a,'b) index -> bool
	val mkindex: ('a,'b) point * ('a,'b) range -> ('a,'b) index
	val at: ('a,'b) index -> ('a,'b) value
    end;

Most of the polymorphic functions that get generated from BASICACCESS
structures will never need both type variables, while others may need
more than two.

For example,

structure BasicListIndex =
    struct
	type ('a,'b) point = 'a list
	type ('a,'b) value = 'a
	type ('a,'b) index = 'a list
	type ('a,'b) range = 'a list
	fun first x = x
	val succ = tl
	val done = null
	fun mkindex(x,y) = x
	fun at x = System.Unsafe.cast (hd x)  (* bug in NJSML .70 type checker ? *)
    end;

structure BasicArrayIndex =
    struct
	type ('a,'b) point = int
	type ('a,'b) index = int * int
	type ('a,'b) range = int
	fun first(limit:('a,'b) range):('a,'b) index = (0,limit)
	fun succ((x,limit):('a,'b) index):('a,'b) index = (x+1,limit)
	fun done((x,limit):('a,'b) index):bool = x>=limit
	fun at x = x
	fun mkindex(x,r) = (x,r)
	fun index1((x,_):('a,'b) index) = x
    end;

Carrying around the dummy type variables on types like "('a,'b) point"
is a bother. Perhaps a simple solution would be to allow the user to
omit type variables if they are specified as wildcards, e.g., "type
('_,'_) point = int" can be used simply as "val x : point" with the
compiler inserting the missing (wildcard) type variables by
convention.

More generally, it would seem to be nice if type constructors could
take variable numbers of arguments, and if they could pass their
argument lists around as complete entities (analogous to passing
around tuples of arguments in ML).

Another possibility would be to allow "free" type variables:

   type point = '_ list

This would simply be syntactic sugar for

   type 'a point = 'a list

and the compiler would implicitly provide a dummy argument to "point"
wherever it is used. However, this may break other parts of the type
or module system.

    Point 3 is really about a basic problem with the current
    way signatures and functors handle types, not about "'_". 

    Essentially, I want to write functors that generate objects
    that are polymorphic in different ways, e.g., that sometimes
    generate a function "f : 'a -> 'a" and sometimes "f : 'a -> 'b".

    The only way I could find of writing signatures for such functors is to
    make both the LHS and the RHS types (e.g.  type ('a,'b) arg; type
    ('a,'b) result) that depend on two type variables and instantiate them
    in the matching structures to the correct types. This causes a number
    of problems that I mentioned in my previous message.

    Another possibility would be to allow a function of type "'a -> 'a"
    to match a type specification "'a -> 'b", but that does not
    currently work.

    Functors that generate functions that are polymorphic
    in different ways are very important, and, one way or another,
    SML must make this more convenient than it is right now.

				    Thanks, Thomas.
= 4 ================================================================

A related problem is that nongeneric weak type variables
generate an error even if they are never used:

   - val x: '0a t = 3;
   std_in:3.1-3.16 Error: nongeneric weak type variable
     x : '0aU t
   -

I think you can guess from the above structures and functors
how such non-generic weak type variables can pop up unexpectedly
(they are easy to fix for the user, by simply giving a type
to the value, but it seems odd for a user of, say structure
"Array2D" to have to specify some type as "(unit,int) array"
just to create an array of type "int array").

= 5 ================================================================

A minor problem with wildcard type variables:

- type ('_,'_) a;
std_in:7.7-7.11 Error: duplicate type variable: '1
std_in:7.7-7.11 Error: duplicate type variable: '1
std_in:7.7-7.11 Error: duplicate type variable: '1
std_in:7.7-7.11 Error: duplicate type variable: '1
std_in:7.7-7.11 Error: duplicate type variable: '1
- 

I think the "'_" should refer to a new type variable every time it is
used (this is, after all, what "_" does in ML).

Followup discussion:

    Dave MacQueen writes:
     > What you are looking for may be rather difficult to do within the
     > framework of the ML type system.  At first glance it appears to
     > require a serious innovation in the type system to capture an
     > abstraction that could instantiate to both "f : 'a -> 'a" and
     > "f : 'a -> 'b" (note that these two types have different numbers of
     > bound variables).
     > 
     > Do you have any suggestions as to how this could be done?

    I believe it is possible to express type constraints like this
    with SML:

    signature S =
	sig
	    type ('a,'b) from
	    type ('a,'b) to
	    val f : ('a,'b) from -> ('a,'b) to
	end;

    structure X:S =
	struct
	    type ('a,'b) from = 'a
	    type ('a,'b) to = 'a
	    fun f(x) = x
	end;

    structure Y:S =
	struct
	    type ('a,'b) from = 'a * 'b
	    type ('a,'b) to = 'a
	    fun f(x,y) = x
	end;

    (These are actually not accepted by NJ/SML 0.70, even if the types for
    "f" are fully specified in the structure definitions (you get a
    different error message in that case), but I think that's a bug.)

    The main problem is that this use of types in signatures seems to have
    been rather uncommon so far, so, at least NJ/SML has several
    difficulties with it:

     * the type checker/module system (incorrectly?) rejects
       some constructs like this

     * unused type variables need to be instantiated by
       the user when they become weak; instead, the
       language could automatically define such variables to
       be "unit"

     * the type constructors "from" and "to" are really
       auxilliary, and users of S most likely never want
       to see them printed; the current system prints them

     * the writer of the signature "S" has to pick a maximum
       number of auxilliary type variables used as arguments
       to "from" and "to", but I believe that the actual maximum
       number needed depends on the arguments given to the functor,
       not on the functor itself

    I want to state again that I think this feature is important. Without
    the ability to specify signatures that can match structures that are
    polymorphic in different ways, it seems I would have to write
    completely redundant versions of some functors.

    The context in which it came up was writing a functor that generates
    iteration constructs for collections; for some collections, indexes
    and values are different types, for others, they are the same type.

Status: not a bug
---------------------------------------------------------------------------
Number: 409
Title: type checking after functor application
Keywords: 
Submitter:      tmb@ai.mit.edu
Date:           08/05/91
Version:        0.70
System:         Sun4/OS4.1.1
Severity:       ?
Problem:

Basically, I have something like:

functor F(...) =
    struct
        structure A = G(...);
        ...
        open A
    end;

structure X = F(...);

X.A.f arg;               --> works
X.f arg;                 --> fails with a type error

Comment:

X.A.f and X.f must refer to the same value with the same type: A has
simply been opened at the end of structure X. I don't see how X.f
could ever behave differently from X.A.f.

Sorry about the long code needed to reproduce the bug. I had several
guesses what the problem might be due to, but I have not been able
to reduce the code further than this. In particular, the problem
goes away if the last functor application is removed, i.e.,

   functor GeneralArray(structure Index:BASICACCESS) = struct ... end;
   structure Arrays = GeneralArray(structure Index = BasicArrayIndex);

is replaced with

   structure Arrays =
       struct
           structure Index:BASICACCESS = BasicArrayIndex
           ... body of functor GeneralArray ...
       end

Also, don't try to make sense of the code. To isolate the bug this
far, I collapsed several types.

Code: (file foo.sml)
  signature BASICACCESS =
      sig
	  type ('a,'b) index
	  type ('a,'b) range
	  val first: ('a,'b) range -> ('a,'b) index
	  val succ: ('a,'b) index -> ('a,'b) index
	  val done: ('a,'b) index -> bool
      end;

  functor GeneralIteration(structure Access:BASICACCESS) =
      struct
	  local
	      open Access
	  in
	      fun apply f r =
		  let
		      fun loop(i) = if done(i) then () else (f(i); loop(succ(i)))
		  in
		      loop(first(r))
		  end
	  end
      end;

  functor GeneralArray(structure Index:BASICACCESS) =
      struct
	  type ('a,'b) array = 'b Array.array * ('a,'b) Index.range

	  structure ValueIndex =
	      struct
		  type ('a,'b) range = ('a,'b) array
		  type ('a,'b) index = 'b Array.array * ('a,'b)Index.index
		  fun first((a,r):('a,'b) range) = (a,Index.first(r))
		  fun succ((a,r):('a,'b) index) = (a,Index.succ(r))
		  fun done((a,r):('a,'b) index) = Index.done(r)
	      end

	  structure Value = GeneralIteration(structure Access = ValueIndex)

	  fun array(r:(unit,'1b) Index.range,initial):(unit,'1b) array =
	      (Array.array(100,initial),r)

	  open Value
      end;

  structure BasicArrayIndex =
      struct
	  type ('a,'b) index = int * int
	  type ('a,'b) range = int
	  fun first(limit:('a,'b) range):('a,'b) index = (0,limit)
	  fun succ((x,limit):('a,'b) index):('a,'b) index = (x+1,limit)
	  fun done((x,limit):('a,'b) index):bool = x>=limit
      end;

  structure Arrays = GeneralArray(structure Index = BasicArrayIndex);

Transcript:
volterra$ sml
Standard ML of New Jersey, Version 0.70, 1 July 1991
val it = () : unit
- use "foo.sml";
[opening foo.sml]
signature BASICACCESS =
  sig
    type ('a,'b) index
    type ('a,'b) range
    val done : ('a,'b) index -> bool
    val first : ('a,'b) range -> ('a,'b) index
    val succ : ('a,'b) index -> ('a,'b) index
  end
functor GeneralIteration : <sig>
functor GeneralArray : <sig>
structure BasicArrayIndex :
  sig
    eqtype ('a,'b) index
    eqtype ('a,'b) range
    val done : ('a,'b) index -> bool
    val first : ('a,'b) range -> ('a,'b) index
    val succ : ('a,'b) index -> ('a,'b) index
  end
structure Arrays :
  sig
    structure Value : sig...end
    structure ValueIndex : sig...end
    eqtype ('a,'b) array
    val apply : (('a,'b) ?.ValueIndex.index -> 'c) -> ('a,'b) ?.ValueIndex.range
 -> unit
    val array : (unit,'1a) BasicArrayIndex.range * '1a -> (unit,'1a) array
  end
[closing foo.sml]
val it = () : unit
- val x = Arrays.array(100,0);
val x = (prim?,100) : (unit,int) Arrays.array
- Arrays.Value.Apply (fn a => a) x;
std_in:4.1-4.18 Error: unbound variable or constructor in structure: Apply
- Arrays.Value.apply (fn a => a) x;
val it = () : unit
- Arrays.apply (fn a => a) x;
std_in:2.1-2.26 Error: operator and operand don't agree (tycon mismatch)
  operator domain: ('Z,int) ?.ValueIndex.range
  operand:         (unit,int) Arrays.array
  in expression:
    Arrays.apply ((fn <pat> => <exp>)) x
- volterra$

Status: fixed in 0.73
---------------------------------------------------------------------------
Number: 410
Title: inlining property not preserved in simple renaming
Keywords: 
Submitter: Andrew Tolmach (apt@cs.princeton.edu)
Date: 8/6/91
Version: 0.73
Severity: minor
Problem: 
  If I use System.Unsafe.getvar directly, it is inlined, as expected.

  If I type

  val g = System.Unsafe.getvar

  then g does not have access INLINE.

  Dbm suggests that this is because g is being eta-expanded; I haven't found
  where this happens in the source.

  In any case, I don't know why the initial definition of


  val getvar = InLine.getvar

  inside the definition of System.Unsafe *does* manage to transfer the inline
  property...  Is it because there's something special about structure InLine?

Fix: look for MARKexps around the rhs VALvar.
  Tolmach: abstract syntax marking.  The MARKexps surrounding the RHS of

    val a = System.Unsafe.getvar

  prevent the INLINE-ness of getvar being recognized by parse/corelang.sml valbind.
  If I turn off marking, it works.
  Tarditi: We should alter parse/corelang.sml valbind so that it recognizes this
  case specially and properly assigns the INLINE property.

Status: fixed in 0.74
---------------------------------------------------------------------------
Number: 411
Title: Runbind
Keywords: 
Submitter: John Reppy (jhr)
Date: 8/10/91
Version: 0.71
Problem: Runbind exception
Transcript:

  Standard ML of New Jersey, Version 0.71, 23 July 1991
  val it = () : unit
  - structure A = struct val x = 1 end;
  structure A :
    sig
      val x : int
    end
  - structure B = struct structure A = A; val y = 2 end;
  structure B :
    sig
      structure A : sig...end
      val y : int
    end
  - open A;
  open A
  - open B;
  open B
  - x;

  uncaught exception Runbind

Status: fixed in 0.73
---------------------------------------------------------------------------
Number: 412
Title: Runbind
Keywords: 
Submitter: Dave Tarditi
Date: 8/13/91
Version: 0.71
Problem: 
Code: 
    structure A =
       struct
	 val x = 5
	 structure B = 
	    struct
	       val y = 5
	    end
       end

    open A.B;
    structure A = struct end;
    y;
Comments: (Tarditi)
  There's an incorrect assumption in checkopen, which tests whether
  any value in a structure which has been rebound is still accessible.
  Let the old structure be called S and the new environment be N.  Let
  the symbols bound in the environment of S be T.   The assumption is
  that if any symbol A in T is unbound in N, then all other symbols
  in T are also unbound in N.  This is clearly untrue, as the above
  example shows, where x is unbound in the environment after the redefinition
  of A but y is not.

Status: fixed in 0.73
---------------------------------------------------------------------------
Number: 413
Title: System and IO problems
Keywords: 
Submitter: Emden Gansner
Date: 8/16/91
Version: 0.71
Problem: 
  The version of system in the System structure should have type string -> int

  The execute function in IO is incorrect as written. It passes the
  the value of environ() to exec, but this is a list of SML strings
  and exec expects a list of C strings. It should pass (map c_string environ())
  instead.

  Finally, the execute function would be a lot more useful if it allowed
  a list of arguments as well as program pathname.
Status: fixed in 0.74 (JHR)
---------------------------------------------------------------------------
Number: 414
Title: getWD wrong
Keywords: 
Submitter : Ian King <ik@sys.uea.ac.uk>
Date: 8/19/91
Version   : 0.66
System    : Sun 3/160 , Sun OS 4.1
Severity  : Minor
Problem   : The function getWD in structure System.Directory when called 
            with a unit gives an incoorect result.
Code      : fun test path =
                let
                   val cwd = System.Directory.getWD ()
                in
                   { cd_in = fn () => (cd path),
                     cd_out = fn () => (cd cwd) }
                end
Transcipt  : val {cd_in,cd_out} = test "directoryname";
                val cd_in = fn : unit -> unit
                val cd_out = fn : unit -> unit

             cd_in ();
                val it = () : unit;

             cd_out ();
                uncaught exception NotDirectory

Comments   : This code executes correctly on a Sun Sparc machine. It does not 
             execute correctly on our Sun 3/160. Although I have marked the
             bug as minor it is irritating because it crashes code which
             needs to change directories such as loaders.
	     ** This is probably another example of bug #651 (JHR, 10/6/92) **
Status: fixed in 0.75
---------------------------------------------------------------------------
Number: 415
Title: late error detection in parsing
Keywords: 
Submitter:      David N. Turner <dnt@dcs.ed.ac.uk>
Date:		9/17/91
Version:        SML of NJ version 0.73
System:         Sun4
Severity:       minor
Problem:

	The following incorrect text doesn't generate an error,
	the secondary prompt appears and the error is only signalled
 	after more text if typed in. Perhaps this is some kind of
	parser lookahead problem?

	- if true then 365;		(* My input 	*)
	=				(* nj-sml output *)
Owner: Andrew
Status: open
---------------------------------------------------------------------------
Number: 416
Title: equality property checking in functor parameter matching
Keywords: modules, functors, signature matching, equality
Submitter: Simon Finn <simon@abstract-hardware-ltd.co.uk>
Date: 9/13/91
Version: ?
Severity: minor
Problem: 
Try the following simple (?) exercise in semantics, provided by my
colleague Mike Crawley:
 
	signature PSIG =
	sig
	  eqtype 'a symTab ;
          datatype guide = G1 | G2 of guide symTab
        end;

(Q1) Is guide an eqtype? (in PSIG)
(A1) Yes, since we require the equality-principal signature.

	functor PFUN (structure S : sig type 'a symTab end) =
	struct
	  open S;
	  datatype guide = G1 | G2 of guide symTab;
	end;

(Q2) Is guide an eqtype? (in the output signature of PFUN)
(A2) No, because symTab isn't and our signatures must respect equality


	structure S = struct datatype 'a symTab = Empty end;
	structure P = PFUN(structure S = S);

(Q3) Is guide an eqtype? (in the signature of P)
(A3) No, because it wasn't in the functor.
     Technically, this is because the realisation, \phi, used
     to instantiate the body of the functor doesn't touch
     the bound type names contained in the output signature
     of the functor (except, possibly, for an alpha-conversion).
     
	P.G1 = P.G1;

(Q4) Is this legal?
(A4) No, because P.guide is not an eqtype (see above).

	functor MFUN(structure X : PSIG) =
	struct
	  val z = X.G1 = X.G1;
	end;
	structure M = MFUN(structure X = P);

(Q5) Is this legal?
(A5) No, because MFUN demands that guide be an eqtype (see Q1),
     but P.guide is not an eqtype (see Q3, Q4).


Both SMLNJ 0.66 and Poly/ML 1.88 get Q1 - Q4 right but get Q5 wrong.
Poly/ML 1.98 gets Q1 - Q5 right.

Comment: Conjecture that this is a benign bug.  Have not been able to
  come up with version that is actually wrong.

Fix: Could record equality properties inferred in parameter signature
     instantiation in the signature (memoizing).

Test: bug416.sml
Owner: dbm
Status: open
---------------------------------------------------------------------------
Number: 417
Title: cosmetic error message suggestion
Keywords: error message
Submitter: Andy Koenig
Date: 9/12/91
Version: ?
Problem: 
  Minor suggestion for SML-NJ:  in error messages, how about
  printing infix functions as infix?

Transcript: 
  - 3 + 4.0;
  std_in:1.1-1.7 Error: operator and operand don't agree (tycon mismatch)
    operator domain: int * int
    operand:         int * real
    in expression:
      + (3,4.0)
      ^^^^^^^^^     Why not  3+4.0      ??
		    or at least op+ (3,4.0)

Comment: use original code in error message instead of "pretty-printing"
  abstract syntax
Owner: 
Status: open
---------------------------------------------------------------------------
Number: 418
Title: repeated type names in type declarations
Keywords: 
Submitter:      Andrzej Filinski <andrzej@cs.cmu.edu>
Date:		9/11/91
Version:        0.72
System:         All
Severity:       minor (but with potentially serious consequences)
Problem:        Repeated type names in DATATYPE ... WITHTYPE ...
		destroy type security.
Transcript:     Standard ML of New Jersey, Version 0.72, 29 August 1991
		val it = () : unit
		- datatype t = T of int withtype t = string;
		datatype  t
		con T : int -> t
		type  t = string
		- T 65:string;
		val it = "A" : string
		-
Comments:	Same problem with ABSTYPE...WITHTYPE. See also bug report 349.

Status: fixed in 0.74
---------------------------------------------------------------------------
Number: 419
Title: Runbind
Keywords: 
Submitter:      Venkatesh Akella  akella@cs.utah.edu
Date:		8/27/91
Version:        SML of NJ version 0.71
System:         Sparc IPC, SunOS
Severity:       major
Problem:        Raises an uncaught exception Runbind when
		a simple CML program running under SML version 0.71
		(Version of CML being used is 0.95)
		The bug can't be reproduced with CML version 0.90 running
		under SML/NJ 0.66
Code:

fun placeBuffer () =
   let 
	val c = channel () 
	val b = channel () 
	val a = channel ()
	fun input_int (s:string) =
	    fold (fn(a,r) => ord(a) - ord("0") + 10 * r) (tl (rev(explode s))) 0;

	fun P1 x   = (CIO.print( "Waiting for Input on Channel a? \n");
		let
			val y =  input_int(CIO.input_line std_in)
		in
			s__3 x y
		end)
	and 
 	    s__3 x y   = ( ( send (c,y ) ; P1 y  ))

	fun P2 z   = (let val v =  accept  c in s__5 z v  end)
	and 
  	   s__5 z v  =
	( (CIO.print (" Output on Channel b!"^Integer.makestring(v)^"\n");
	P2 v  ))
   in 
	 spawn (fn () => P1 4  );
	 spawn (fn () => P2 5  );
	() 
 	 end;

Transcript:

6 bliss /u/akella/compiler/cml/cml95/cml-0.9.5:: > cml
val it = true : bool
- System.Directory.cd "/u/akella/compiler/hop/example";
val it = () : unit
- use "test_buf.sml";
[opening test_buf.sml]
[closing test_buf.sml]

uncaught exception Runbind
-

Comments:
	The same bug was observed in SML/NJ version 0.66 too but in
	a different context. I had one integrated environment with
	SML 0.66, ML-yacc, ML-lex, CML(version 0.9) and my own code.

Status: fixed in 0.74
---------------------------------------------------------------------------
Number: 420
Title: uncaught Nth while compiling
Keywords: 
Submitter:	Tsung-Min Kuo	kuo@ecrc.de
Date:		9/19/91
Version:        Version 0.66, 15 September 1990
System:         SPARCstation 1, SUNOS 4.0
Severity:	sever
Problem:        Compiler-generated exception : uncaught exception Nth
Code:
	signature EXCHANGE_STRUCTURE =
	sig
	   type tree 
	   val new_node : tree -> tree
	end
	
	structure ex : EXCHANGE_STRUCTURE =
	struct
	datatype tree = Subwindow of subwindow
		      | Canvas of canvas
		      | Frame of frame
		      | Baseframe of baseframe
		      | NULL
	withtype subwindow = {t_node: tree}
	and canvas = {subwindow: subwindow}
	and frame = {tree_node: tree}
	and baseframe = {frame: frame,foog:bool} 
	
	exception Tube_Bug
	
	fun position (Canvas c) = position(Subwindow(#subwindow c))
	  | position (Baseframe bf) = position(Frame (#frame bf))
	  | position _ = raise Tube_Bug
	
	fun tn_set_position(t,p) = ()
	fun set_position (Subwindow sb) = tn_set_position(#t_node sb,0)
	  | set_position (Frame f) = tn_set_position(#tree_node f,0)
	  | set_position (Canvas c) = set_position(Subwindow(#subwindow c))
	  | set_position (Baseframe bf) = set_position(Frame(#frame bf))
	  | set_position _ = raise Tube_Bug
	
	fun components(Canvas c) = components(Subwindow (#subwindow c))
	  | components(Baseframe bf) = components(Frame (#frame bf))
	  | components _ = raise Tube_Bug
	
	fun bounding_box(Canvas c) = bounding_box(Subwindow (#subwindow c))
	  | bounding_box(Baseframe bf) = bounding_box(Frame (#frame bf))
	  | bounding_box _ = raise Tube_Bug
	
	fun tn_set_bounding_box(t,r) = ()
	fun set_bounding_box(Subwindow sb) = tn_set_bounding_box(#t_node sb,0)
	  | set_bounding_box(Frame f) = tn_set_bounding_box(#tree_node f,0)
	  | set_bounding_box(Canvas c) = set_bounding_box(Subwindow(#subwindow c))
	  | set_bounding_box(Baseframe bf) = set_bounding_box(Frame(#frame bf))
	  | set_bounding_box _ = raise Tube_Bug
	
	fun new_node tl =
	   let
	      val pos = position(Frame {tree_node = tl})
	   in
	      NULL
	   end
	end

Transcript:
	- use "bug";
	[opening bug]
	[closing bug]

	uncaught exception Nth
	-
Comments: The enclosed code is a trimmed version of a big program, got in an
	  attempt to isolate the error. As you can see, this program virtually
	  does nothing and is full of redundancy. But whatever I did to try to
	  cut it down, results in a good program happily accepted by compiler.
	  Here are some of the things I have tried :
	  * not use the signature constraint on the structure
	  * delete any of the redundant function definitions, e.g."components"
	  * remove the redundant call to function "position" in "new_node"
	  * or, even call "position" with argument NULL
	  * remove a clause from any function definition(I tried many of them)
	  * flat the record, e.g. make type frame = tree
	  * remove the boolean field in type "baseframe"
	  * get rid of second argument of functions "tn_set_position" and
	    "tn_set_bounding_box"
	  * replace equal by equal, e.g. replace calls to "tn_set_position"
	    by ()
	  * replace recursive call by direct call, e.g. in "Canvas" clause of
	    function "set_position"
	Conclusion: These are so diverse that I can not even guess any.

Status: fixed in 0.73
---------------------------------------------------------------------------
Number: 421
Title: getWD under SPARC/Mach (same as 353)
Keywords: 
Submitter: Fritz Knabe <Frederick_Knabe@ARCTIC.FOX.CS.CMU.edu>
Date: 9/18/91
Version: 0.73
System: SPARC/Mach (CMU)
Severity: minor
Problem: 
  System.Directory.getWD () is still broken for me in version 73
  on a Sparc. It raises a SystemCall exception.
Transcript: (c/o Gene Rollins, 8/21/92)
Standard ML of New Jersey, Version 0.88, August 14, 1992
  with SourceGroup 2.2 built on Mon Aug 17 23:23:16 EDT 1992
- fun pwd() = System.system "pwd";
val pwd = fn : unit -> int
- fun cd x = (System.Directory.cd x; pwd()) handle any => (pwd(); raise any);
val cd = fn : string -> int
- fun ll () = System.system "ls -lL";
val ll = fn : unit -> int
- fun mkdir x = System.system ("mkdir " ^ x);
val mkdir = fn : string -> int
- pwd();
/usr0/rollins
val it = 0 : int
- ll();
total 0
val it = 0 : int
- mkdir "src";
val it = 0 : int
- mkdir "bin";
val it = 0 : int
- ll();
total 2
drwxr-xr-x  2 rollins       512 Aug 20 12:16 bin
drwxr-xr-x  2 rollins       512 Aug 20 12:16 src
val it = 0 : int
- cd "src";
/usr0/rollins/src
val it = 0 : int
- cd "../bin";
/usr0/rollins/bin
val it = 0 : int
- cd "../src";
/usr0/rollins/src
val it = 0 : int
- cd "..";
/usr0/rollins
val it = 0 : int
- cd "bin";
/usr0/rollins/bin
val it = 0 : int
- cd "..";
/usr0/rollins
val it = 0 : int
- ll();
total 2
drwxr-xr-x  2 rollins       512 Aug 20 12:16 bin
drwxr-xr-x  2 rollins       512 Aug 20 12:16 src
val it = 0 : int
- mkdir "tools";
val it = 0 : int
- cd "src";
/usr0/rollins/src
val it = 0 : int
- cd "../tools";
/usr0/rollins/src

uncaught exception NotDirectory
- cd "../bin";
/usr0/rollins/bin
val it = 0 : int
- cd "../tools";
/usr0/rollins/bin

uncaught exception NotDirectory  (* the rest is more of the same *)
- cd "..";
/usr0/rollins
val it = 0 : int
- cd "tools";
/usr0/rollins/tools
val it = 0 : int
- cd "../src";
/usr0/rollins/src
val it = 0 : int
- cd "../tools";
/usr0/rollins/src

uncaught exception NotDirectory
- cd "..";
/usr0/rollins
val it = 0 : int
- ll();
total 3
drwxr-xr-x  2 rollins       512 Aug 20 12:16 bin
drwxr-xr-x  2 rollins       512 Aug 20 12:16 src
drwxr-xr-x  2 rollins       512 Aug 20 12:17 tools
val it = 0 : int
- mkdir "mo.mipsl";
val it = 0 : int
- ll();
total 4
drwxr-xr-x  2 rollins       512 Aug 20 12:16 bin
drwxr-xr-x  2 rollins       512 Aug 20 12:18 mo.mipsl
drwxr-xr-x  2 rollins       512 Aug 20 12:16 src
drwxr-xr-x  2 rollins       512 Aug 20 12:17 tools
val it = 0 : int
- cd "mo.mipsl";
/usr0/rollins

uncaught exception NotDirectory
- cd "src";
/usr0/rollins/src
val it = 0 : int
- cd "../mo.mipsl";
/usr0/rollins/mo.mipsl
val it = 0 : int
- cd "../tools";
/usr0/rollins/mo.mipsl

uncaught exception NotDirectory
- cd "../bin";
/usr0/rollins/bin
val it = 0 : int
- cd "../mo.mipsl";
/usr0/rollins/mo.mipsl
val it = 0 : int
- cd "..";
/usr0/rollins
val it = 0 : int
- cd "mo.mipsl";
/usr0/rollins

uncaught exception NotDirectory
- ll();
total 4
drwxr-xr-x  2 rollins       512 Aug 20 12:16 bin
drwxr-xr-x  2 rollins       512 Aug 20 12:18 mo.mipsl
drwxr-xr-x  2 rollins       512 Aug 20 12:16 src
drwxr-xr-x  2 rollins       512 Aug 20 12:17 tools
val it = 0 : int
- mkdir "zed";
val it = 0 : int
- ll();
total 5
drwxr-xr-x  2 rollins       512 Aug 20 12:16 bin
drwxr-xr-x  2 rollins       512 Aug 20 12:18 mo.mipsl
drwxr-xr-x  2 rollins       512 Aug 20 12:16 src
drwxr-xr-x  2 rollins       512 Aug 20 12:17 tools
drwxr-xr-x  2 rollins       512 Aug 20 12:23 zed
val it = 0 : int
- cd "zed";
/usr0/rollins/zed
val it = 0 : int
- cd "../tools";
/usr0/rollins/zed

uncaught exception NotDirectory
- cd "../src";
/usr0/rollins/src
val it = 0 : int
- cd "../zed";
/usr0/rollins/zed
val it = 0 : int
- cd "..";
/usr0/rollins
val it = 0 : int
- mkdir "moon";
val it = 0 : int
- cd "moon";
/usr0/rollins

uncaught exception NotDirectory
- cd "src";
/usr0/rollins/src
val it = 0 : int
- cd "../moon";
/usr0/rollins/moon
val it = 0 : int
- cd "..";
/usr0/rollins
val it = 0 : int
- ll();
total 6
drwxr-xr-x  2 rollins       512 Aug 20 12:16 bin
drwxr-xr-x  2 rollins       512 Aug 20 12:18 mo.mipsl
drwxr-xr-x  2 rollins       512 Aug 20 12:24 moon
drwxr-xr-x  2 rollins       512 Aug 20 12:16 src
drwxr-xr-x  2 rollins       512 Aug 20 12:17 tools
drwxr-xr-x  2 rollins       512 Aug 20 12:23 zed
val it = 0 : int
- mkdir "tooth";
val it = 0 : int
- ll();
total 7
drwxr-xr-x  2 rollins       512 Aug 20 12:16 bin
drwxr-xr-x  2 rollins       512 Aug 20 12:18 mo.mipsl
drwxr-xr-x  2 rollins       512 Aug 20 12:24 moon
drwxr-xr-x  2 rollins       512 Aug 20 12:16 src
drwxr-xr-x  2 rollins       512 Aug 20 12:17 tools
drwxr-xr-x  2 rollins       512 Aug 20 12:25 tooth
drwxr-xr-x  2 rollins       512 Aug 20 12:23 zed
val it = 0 : int
- cd "tooth";
/usr0/rollins/tooth
val it = 0 : int
- cd "../src";
/usr0/rollins/src
val it = 0 : int
- cd "../tooth";
/usr0/rollins/src

uncaught exception NotDirectory
- cd "..";
/usr0/rollins
val it = 0 : int
- ll();
total 7
drwxr-xr-x  2 rollins       512 Aug 20 12:16 bin
drwxr-xr-x  2 rollins       512 Aug 20 12:18 mo.mipsl
drwxr-xr-x  2 rollins       512 Aug 20 12:24 moon
drwxr-xr-x  2 rollins       512 Aug 20 12:16 src
drwxr-xr-x  2 rollins       512 Aug 20 12:17 tools
drwxr-xr-x  2 rollins       512 Aug 20 12:25 tooth
drwxr-xr-x  2 rollins       512 Aug 20 12:23 zed
val it = 0 : int
- cd "mzz";
/usr0/rollins

uncaught exception NotDirectory
- mkdir "mzz";
val it = 0 : int
- cd "mzz";
/usr0/rollins/mzz
val it = 0 : int
- cd "../src";
/usr0/rollins/src
val it = 0 : int
- cd "../mzz";
/usr0/rollins/mzz
val it = 0 : int
- mkdir "me";
val it = 0 : int
- ll();
total 1
drwxr-xr-x  2 rollins       512 Aug 20 12:26 me
val it = 0 : int
- pwd();
/usr0/rollins/mzz
val it = 0 : int
- cd "..";
/usr0/rollins
val it = 0 : int
- mkdir "me";
val it = 0 : int
- ll();
total 9
drwxr-xr-x  2 rollins       512 Aug 20 12:16 bin
drwxr-xr-x  2 rollins       512 Aug 20 12:26 me
drwxr-xr-x  2 rollins       512 Aug 20 12:18 mo.mipsl
drwxr-xr-x  2 rollins       512 Aug 20 12:24 moon
drwxr-xr-x  3 rollins       512 Aug 20 12:26 mzz
drwxr-xr-x  2 rollins       512 Aug 20 12:16 src
drwxr-xr-x  2 rollins       512 Aug 20 12:17 tools
drwxr-xr-x  2 rollins       512 Aug 20 12:25 tooth
drwxr-xr-x  2 rollins       512 Aug 20 12:23 zed
val it = 0 : int
- cd "me";
/usr0/rollins/me
val it = 0 : int
- cd "../tooth";
/usr0/rollins/me

uncaught exception NotDirectory
- cd "..";
/usr0/rollins
val it = 0 : int
- mkdir "teeth";
val it = 0 : int
- cd "teeth";
/usr0/rollins/teeth
val it = 0 : int
- cd "../src";
/usr0/rollins/src
val it = 0 : int
- cd "../teeth";
/usr0/rollins/src

uncaught exception NotDirectory
- cd "..";
/usr0/rollins
val it = 0 : int
- ll();
total 10
drwxr-xr-x  2 rollins       512 Aug 20 12:16 bin
drwxr-xr-x  2 rollins       512 Aug 20 12:26 me
drwxr-xr-x  2 rollins       512 Aug 20 12:18 mo.mipsl
drwxr-xr-x  2 rollins       512 Aug 20 12:24 moon
drwxr-xr-x  3 rollins       512 Aug 20 12:26 mzz
drwxr-xr-x  2 rollins       512 Aug 20 12:16 src
drwxr-xr-x  2 rollins       512 Aug 20 12:27 teeth
drwxr-xr-x  2 rollins       512 Aug 20 12:17 tools
drwxr-xr-x  2 rollins       512 Aug 20 12:25 tooth
drwxr-xr-x  2 rollins       512 Aug 20 12:23 zed
val it = 0 : int
- mkdir "tzz";
val it = 0 : int
- ll();
total 11
drwxr-xr-x  2 rollins       512 Aug 20 12:16 bin
drwxr-xr-x  2 rollins       512 Aug 20 12:26 me
drwxr-xr-x  2 rollins       512 Aug 20 12:18 mo.mipsl
drwxr-xr-x  2 rollins       512 Aug 20 12:24 moon
drwxr-xr-x  3 rollins       512 Aug 20 12:26 mzz
drwxr-xr-x  2 rollins       512 Aug 20 12:16 src
drwxr-xr-x  2 rollins       512 Aug 20 12:27 teeth
drwxr-xr-x  2 rollins       512 Aug 20 12:17 tools
drwxr-xr-x  2 rollins       512 Aug 20 12:25 tooth
drwxr-xr-x  2 rollins       512 Aug 20 12:27 tzz
drwxr-xr-x  2 rollins       512 Aug 20 12:23 zed
val it = 0 : int
- cd "tzz";
/usr0/rollins/tzz
val it = 0 : int
- cd "../src";
/usr0/rollins/src
val it = 0 : int
- cd "../tzz";
/usr0/rollins/tzz
val it = 0 : int
- cd "../teeth";
/usr0/rollins/tzz

uncaught exception NotDirectory
- cd "..";
/usr0/rollins
val it = 0 : int
- ll();
total 11
drwxr-xr-x  2 rollins       512 Aug 20 12:16 bin
drwxr-xr-x  2 rollins       512 Aug 20 12:26 me
drwxr-xr-x  2 rollins       512 Aug 20 12:18 mo.mipsl
drwxr-xr-x  2 rollins       512 Aug 20 12:24 moon
drwxr-xr-x  3 rollins       512 Aug 20 12:26 mzz
drwxr-xr-x  2 rollins       512 Aug 20 12:16 src
drwxr-xr-x  2 rollins       512 Aug 20 12:27 teeth
drwxr-xr-x  2 rollins       512 Aug 20 12:17 tools
drwxr-xr-x  2 rollins       512 Aug 20 12:25 tooth
drwxr-xr-x  2 rollins       512 Aug 20 12:27 tzz
drwxr-xr-x  2 rollins       512 Aug 20 12:23 zed
val it = 0 : int
- 
Comment: (Lal George)
  There is an operating system level 3 call that can be used to
  get the working directory.
  Unfortunately, we cannot use this because it does a malloc.
  So we have to build up the working directory pathname by
  interpreting inodes.
  It is my guess that this is what bombs out in the Andrew file
  system.
  ** This is probably another example of bug #651 (JHR, 10/6/92) **
Status: fixed in 0.75
---------------------------------------------------------------------------
Number: 422
Title: overflow on int to real conversion
Keywords: 
Submitter:      Andrzej Filinski <andrzej@cs.cmu.edu>
Date:		9/20/91
Version:        0.73
System:         all
Severity:       major
Problem:        int->real conversion overflows on MININT
Transcript:     Standard ML of New Jersey, Version 0.73, 10 September 1991
		Arrays have changed; see doc/NEWS
		val it = () : unit
		- ~0x40000000;
		val it = ~1073741824 : int
		- real it;	

		uncaught exception Overflow
		-	
Fix:		In boot/perv.sml, move redundant check for MININT
                from Integer.mod to Real.real  :-).

Status: fixed in 0.74
---------------------------------------------------------------------------
Number: 423
Title: printing of structure signatures
Keywords: 
Submitter: John Reppy
Date: 10/1/91
Version: 0.73
Severity: minor
Problem: 
  At top level, some structure signatures are printed as identifiers,
  while others are printed in full.
Transcript: 
  Standard ML of New Jersey, Version 0.73, 10 September 1991
  Arrays have changed; see doc/NEWS
  val it = () : unit
  - structure I = IO;
  structure I : IO
  - structure V = Vector;
  structure V : 
    sig
      eqtype 'a vector
      exception Size
      exception Subscript
      val length : 'a vector -> int
      val sub : 'a vector * int -> 'a
      val tabulate : int * (int -> 'a) -> 'a vector
      val vector : 'a list -> 'a vector
      val vector_n : int * 'a list -> 'a vector
    end
  - 
Comments: [Dave Tarditi]
The reported behavior is intentional: the basic idea is that if we know
the name of a structure's signature, we print the name of the signature
instead of the whole signature.

More formally, if S is structure which is bound to structure id SX,
and S was the result of doing a signature match against signature T,
which itself is bound to signature identifier TX, then when we print
the signature for the structure bound to SX, we will print TX, provided
that TX is still bound to the same signature.

Thus we get the following results at the top-level:

- structure S = IO;
structure S : IO
- structure T = S;
structure T : IO

but when we re-bind the signature identifier IO we get:

- signature IO = sig end;
signature IO =
  sig
  end
- structure S = IO
structure S =
  sig 
    type instream
  ...
  end

The problem is that the signature identifier VECTOR is not in 
the top-level environment.  To fix this, change
build/process.sml, lines 202-204 from:

           map Symbol.sigSymbol ["REF","LIST","ARRAY","BYTEARRAY","IO","BOOL",
 				 "ENVIRON", "COMPILE", 
		                 "STRING","INTEGER","REAL","GENERAL"]
to:
           map Symbol.sigSymbol ["REF","LIST","ARRAY","BYTEARRAY","IO","BOOL",
 				 "ENVIRON", "COMPILE"
		                 "STRING","INTEGER","REAL","GENERAL",
	                         "VECTOR"]

Maybe we should add a flag to toggle this behavior, but I was hoping
that we would an environment browsing structure to the compiler
instead.  It's a kludge to have to type "structure S = S" to see the
signature of S.

Status: not a bug (but a feature!)
---------------------------------------------------------------------------
Number: 424
Title: IO.execute on SPARC
Keywords: 
Submitter: Emden Gansner
Date: 10/1/91
Version: 0.73
System: SPARC, SunOS 4.1
Severity: moderate
Problem: 
    "I just noticed that, starting with 0.71, the IO.execute function
    causes problems on the sparc, running SunOS4.1. This problem 
    doesn't occur on 0.73 running on hunny."
Transcript: 
  t) /usr/addon/sml/bin/*69*
  Standard ML of New Jersey, Version 0.69, 3 April 1991
  val it = () : unit
  - IO.execute "/bin/date";
  val it = (-,-) : instream * outstream
  - t)
  t) sml
  Standard ML of New Jersey, Version 0.71, 23 July 1991
  val it = () : unit
  - IO.execute "/bin/date";
  /home/erg/bin/sml[7]: 6446 Bus error
  t) sml73
  Standard ML of New Jersey, Version 0.73, 10 September 1991
  val it = () : unit
  - IO.execute "/bin/date";
  Bus error
  t)
Status: fixed in 0.74 (JHR)
---------------------------------------------------------------------------
Number: 425
Title: profiler flakiness
Keywords: 
Submitter: Frank Pfenning
Date: 10/2/91
Version: 0.73
Problem: 
    I am currently in the process of eliminating obvious inefficiencies in an ML
  implementation of a logic programming language.  While using the profiler, I
  noticed that it seemed to lead to inordinately large core images during the
  development (there is also a small overhead for the mere fact that we are
  profiling, but that is acceptable).  My guess is the profiler keeps a
  (non-weak) pointer to code somehow, which prevents it from being garbage
  collected even if it is no longer accessible from the top-level.  The fact
  that redefined functions show up twice or more often in the profiling
  statistics seem to confirm that, but I may be using it wrong, or there could
  be other reasons.  I would be interested to hear what the
  developer/implementor of the profiler has to say about this.  Thanks,
Comment: (Andrew Appel)
  Yes, I think your analysis is correct.
  There's a profiler function that resets the profiler; perhaps that's
  what you want.  But if you use it, you'd have to reload your entire
  source code.
Status: fixed in 0.86
---------------------------------------------------------------------------
Number: 426
Title: type printing
Keywords: 
Submitter: Andy Koenig (europa!ark)
Date: 10/4/91
Version: 0.73
Severity: minor
Problem: 
  Spurious parenthesis around unit.
Transcript: 
	- (3,());
	val it = (3,()) : int * (unit)
Status: fixed in 0.74
---------------------------------------------------------------------------
Number: 427
Title: Compiler bug: defineEqTycon/eqtyc
Keywords: 
Submitter: John Reppy
Date: 10/6/91
Version: 0.73
Severity: ?
Problem: 
  Compiler bug: defineEqTycon/eqtyc -- bad tycon
Transcript: 
  Standard ML of New Jersey, Version 0.73, 10 September 1991
  Arrays have changed; see doc/NEWS
  val it = () : unit
  - 	datatype 'a array = ARRAY of 'a ref VECTOR;
  std_in:2.38-2.43 Error: unbound type constructor VECTOR
  Error: Compiler bug: defineEqTycon/eqtyc -- bad tycon
Comments:
  Obviously this code is incorrect, but I have a bigger example that
  only prints out the "bad tycon" message.
Status: fixed in 0.74
---------------------------------------------------------------------------
Number: 428
Title: openStructureVar -- bad access value
Keywords: 
Submitter:      Benjamin.Pierce@cs.cmu.edu
Date:		4/3/91
Version:        0.67 (with SourceGroup)
System:         SunOS 4.1
Severity:       Major
Problem:        Compiler bug: EnvAccess.openStructureVar -- bad access value
Code:           see below
Transcript:     

Standard ML of New Jersey, Version 0.67, 21 November 1990
(Built on Sun Mar 17 11:37:30 EST 1991 with GnuTags and SourceGroup)
val it = () : unit
- use "bad.tmp";
[opening bad.tmp]
signature WR =
  sig
    type Wr
    val close : Wr -> unit
    val extract_str : Wr -> string
    val to_file : string -> Wr
    val to_fn : (string -> unit) -> (unit -> unit) -> Wr
    val to_nowhere : unit -> Wr
    val to_stdout : unit -> Wr
    val to_string : unit -> Wr
    val to_wrs : Wr list -> Wr
    val write_wr : Wr -> string -> unit
  end
signature PP =
  sig
    structure Wr : sig...end
    type Pp
    val DEBUG : bool ref
    val break : Pp -> bool -> int -> unit
    val endb : Pp -> unit
    val expbreak : Pp -> bool -> string -> unit
    val pp_from_wr : Wr.Wr -> Pp
    val pwrite : Pp -> string -> unit
    val set_margin : Pp -> int -> unit
    val setb : Pp -> unit
    val wr_from_pp : Pp -> Wr.Wr
  end
signature WRMGT =
  sig
    structure Pp : sig...end
    structure Wr : sig...end
    val get_current_wr : unit -> Wr.Wr
    val set_current_wr : Wr.Wr -> unit
    val stdpp : unit -> Pp.Pp
    val write : string -> unit
  end
signature STRINGUTILS =
  sig
  end
signature REGISTRY =
  sig
    type registeredtype
    val register : string -> (registeredtype -> unit) -> unit
    val registerflag : string -> registeredtype ref -> unit
    val set_all : registeredtype -> unit
    val set_flag : string -> registeredtype -> unit
  end
signature LISTUTILS =
  sig
    val filter : ('a -> bool) -> 'a list -> 'a list
    val forall : ('a -> bool) -> 'a list -> bool
    val forsome : ('a -> bool) -> 'a list -> bool
    val mapappend : ('a -> 'b list) -> 'a list -> 'b list
    val mapfold : ('a -> 'b) -> ('b -> 'b -> 'b) -> 'b -> 'a list -> 'b
    val mapunit : ('b -> 'a) -> 'b list -> unit
    val mapunit_tuple : ('a -> unit) -> (unit -> unit) -> 'a list -> unit
    val memq : ('a -> 'a -> bool) -> 'a list -> 'a -> bool
  end
signature ID =
  sig
    type T
    val == : T -> T -> bool
    val hashcode : T -> int
    val intern : string -> T
    val new : unit -> T
    val new_from : T -> T
    val tostr : T -> string
  end
signature DEBUGUTILS =
  sig
    val wrap : bool ref -> string -> (unit -> 'a) -> (unit -> unit) -> ('a -> unit) -> 'a
  end
signature GLOBALS =
  sig
    structure Id : sig...end
    structure Pp : sig...end
    structure Pp : sig...end
    structure Wr : sig...end
    structure Wr : sig...end
    structure WrMgt : sig...end
    type registeredtype
    val filter : ('a -> bool) -> 'a list -> 'a list
    val forall : ('a -> bool) -> 'a list -> bool
    val forsome : ('a -> bool) -> 'a list -> bool
    val get_current_wr : unit -> Wr.Wr
    val mapappend : ('a -> 'b list) -> 'a list -> 'b list
    val mapfold : ('a -> 'b) -> ('b -> 'b -> 'b) -> 'b -> 'a list -> 'b
    val mapunit : ('b -> 'a) -> 'b list -> unit
    val mapunit_tuple : ('a -> unit) -> (unit -> unit) -> 'a list -> unit
    val memq : ('a -> 'a -> bool) -> 'a list -> 'a -> bool
    val register : string -> (registeredtype -> unit) -> unit
    val registerflag : string -> registeredtype ref -> unit
    val set_all : registeredtype -> unit
    val set_current_wr : Wr.Wr -> unit
    val set_flag : string -> registeredtype -> unit
    val stdpp : unit -> Pp.Pp
    val wrap : bool ref -> string -> (unit -> 'a) -> (unit -> unit) -> ('a -> unit) -> 'a
    val write : string -> unit
  end
Error: Compiler bug: EnvAccess.openStructureVar -- bad access value
[closing bad.tmp]
- 


--------------------------------------------------------------------------
(* And here's the offending file ... *)

signature WR = sig

type Wr

val to_stdout: unit -> Wr
val to_file: string -> Wr
val to_nowhere: unit -> Wr
val to_wrs: Wr list -> Wr
val to_fn: (string->unit) -> (unit->unit) -> Wr
val to_string: unit -> Wr
val extract_str: Wr -> string

val close: Wr -> unit

val write_wr: Wr -> string -> unit

end;
signature PP = sig

structure Wr: WR

type Pp

val pp_from_wr: Wr.Wr -> Pp
val wr_from_pp: Pp -> Wr.Wr;

val pwrite : Pp -> string -> unit
val setb: Pp -> unit
val endb: Pp -> unit
val break: Pp -> bool -> int -> unit
val expbreak: Pp -> bool -> string -> unit
val set_margin: Pp -> int -> unit

val DEBUG: bool ref

end;

signature WRMGT = sig

(* Maintains a notion of a current (prettyprinting) writer 
   and its associated prettyprinter *)

structure Wr: WR;
structure Pp: PP;
sharing Pp.Wr = Wr;

val set_current_wr: Wr.Wr -> unit;
val get_current_wr: unit -> Wr.Wr;
val stdpp: unit -> Pp.Pp;

val write: string -> unit;

end;

signature STRINGUTILS = sig

end;

signature REGISTRY = sig

type registeredtype

val register: string -> (registeredtype->unit) -> unit
val registerflag: string -> (registeredtype ref) -> unit

val set_flag: string -> registeredtype -> unit
val set_all: registeredtype -> unit

end;

signature LISTUTILS = sig

val memq: ('a -> 'a -> bool) -> 'a list -> 'a -> bool

val mapappend: ('a -> 'b list) -> ('a list) -> ('b list)
val mapunit: ('a -> 'b) -> ('a list) -> unit
val mapunit_tuple: ('a -> unit) -> (unit -> unit) -> ('a list) -> unit

val mapfold: ('a -> 'b) -> ('b -> 'b -> 'b) -> 'b -> ('a list) -> 'b
val forall: ('a -> bool) -> ('a list) -> bool
val forsome: ('a -> bool) -> ('a list) -> bool

val filter: ('a -> bool) -> ('a list) -> ('a list)

end;

signature ID = sig

type T 

val intern: string -> T
val tostr: T -> string

val hashcode: T -> int 
val new: unit -> T
val new_from: T -> T

val == : T -> T -> bool

end;


(* May eventually want to support these too:

   val lexlt : T -> T -> bool
*)

signature DEBUGUTILS = sig

val wrap: (bool ref) -> string -> (unit -> 'a) -> (unit -> unit) -> ('a -> unit) -> 'a

end;

signature GLOBALS = sig

structure Wr: WR
structure Pp: PP
structure WrMgt: WRMGT
structure Id: ID

sharing Pp.Wr = Wr
sharing WrMgt.Pp = Pp

include WRMGT

include LISTUTILS
include STRINGUTILS
include DEBUGUTILS
include REGISTRY

sharing type registeredtype = bool

end;

signature TYPPVT = sig

structure Globals: GLOBALS
open Globals

datatype pretyp = 
	    PRETVAR of Id.T
	  | PREARROW of pretyp * pretyp
	  | PREALL of Id.T * pretyp * pretyp
	  | PREMEET of pretyp list

datatype T = 
	    TVAR of unit * int
	  | ARROW of unit * T * T
	  | ALL of {name:Id.T} * T * T
	  | MEET of unit * (T list)
	  
datatype tenvelt = BND of Id.T * T
		 | ABB of Id.T * T
		 | VBND of Id.T * T

datatype tenv = TENV of tenvelt list

val empty_tenv: tenv
val extend_bound: tenv -> Id.T -> T -> tenv
val push_bound: tenv -> Id.T -> T -> tenv
val extend_abbrev: tenv -> Id.T -> T -> tenv
val push_abbrev: tenv -> Id.T -> T -> tenv
val extend_binding: tenv -> Id.T -> T -> tenv
val push_binding: tenv -> Id.T -> T -> tenv
val pop: tenv -> tenv

val index: tenv -> Id.T -> int
val lookup_name: tenv -> int -> Id.T
val lookup_and_relocate_bound: tenv -> int -> T
val lookup_and_relocate_binding: tenv -> int -> T
val lookup_and_relocate: tenv -> int -> tenvelt
val lookup: tenv -> int -> tenvelt
val relocate: int -> T -> T

exception UnknownId of string
exception WrongKindOfId of tenv * int * string
val debruijnify: tenv -> pretyp -> T

val prt: Pp.Pp -> tenv -> T -> unit
val prt_tenv: Pp.Pp -> tenv -> unit

val NS: T

end;
Status: fixed in 0.71
---------------------------------------------------------------------------
Number: 429
Title: signature match fails
Keywords: 
Submitter: Benjamin Pierce <Benjamin.Pierce@PROOF.ERGO.CS.CMU.EDU>
Date: 4/4/91
Version: 0.69
Problem: signature spec not matched when it should be
Transcript:
  Standard ML of New Jersey, Version 0.69, 3 April 1991
  val it = () : unit
  - use "bug.tmp";
  use "bug.tmp";
  [opening bug.tmp]

  [Major collection...
  [Increasing heap to 10011k]
   96% used (3502604/3627780), 7260 msec]

  [Increasing heap to 10431k]
  bug.tmp:1545.8-1775.3 Error: value type in structure doesn't match signature spec
    name: prt
    spec:   Pp -> tenv -> T -> unit
    actual: ?.Pp -> tenv -> T -> unit
  bug.tmp:1545.8-1775.3 Error: value type in structure doesn't match signature spec
    name: prt_tenv
    spec:   Pp -> tenv -> unit
    actual: ?.Pp -> tenv -> unit
  bug.tmp:1798.7-1802.44 Error: operator and operand don't agree (tycon mismatch)
    operator domain: ?.Pp
    operand:         ?.Pp
    in expression:
      Typ.prt pp
  bug.tmp:1798.7-1820.56 Error: rules don't agree (tycon mismatch)
    expected: ?.Pp * 'Z * 'Y list * 'X * rhs_flag -> unit
    found:    ?.Pp * tenv * lhsqueue list * 'W * 'V -> 'U
    rule:
      (pp,te,:: (ARROW_LHS <pat>,nil),t2,flag) => (<exp> <exp> te t1;# # t2 flag)
  bug.tmp:1807.7-1809.38 Error: operator and operand don't agree (tycon mismatch)
    operator domain: ?.Pp
    operand:         ?.Pp
    in expression:
      Pp.pwrite pp
  bug.tmp:1798.7-1820.56 Error: rules don't agree (tycon mismatch)
    expected: ?.Pp * 'Z * 'Y list * 'X * rhs_flag -> unit
    found:    ?.Pp * tenv * lhsqueue list * 'W * 'V -> 'U
    rule:
      (pp,te,:: (ARROW_LHS <pat>,X2),t2,flag) => (<exp> <exp> te t1;Pp.pwrite pp ",";# # t2 flag)
  bug.tmp:1811.7-1814.56 Error: operator and operand don't agree (tycon mismatch)
    operator domain: ?.Pp
    operand:         ?.Pp
    in expression:
      Typ.prt pp
  bug.tmp:1811.7-1814.56 Error: operator and operand don't agree (tycon mismatch)
    operator domain: ?.Pp
    operand:         ?.Pp
    in expression:
      describe_rest pp
  bug.tmp:1816.7-1820.56 Error: operator and operand don't agree (tycon mismatch)
    operator domain: ?.Pp
    operand:         ?.Pp
    in expression:
      Typ.prt pp
  bug.tmp:1816.7-1820.56 Error: operator and operand don't agree (tycon mismatch)
    operator domain: ?.Pp
    operand:         ?.Pp
    in expression:
      describe_rest pp
  bug.tmp:1797.1-1820.56 Error: pattern and expression in val rec dec don't agree (tycon mismatch)
    pattern:    ?.Pp -> tenv -> lhsqueue list -> 'Z -> 'Y -> 'X
    expression: ?.Pp -> tenv -> lhsqueue list -> 'W -> rhs_flag -> unit
    in declaration:
      describe_rest = (fn arg => (fn <pat> => <exp>))
  bug.tmp:1823.3-1829.14 Error: operator and operand don't agree (tycon mismatch)
    operator domain: ?.Pp
    operand:         ?.Pp
    in expression:
      Typ.prt pp
  bug.tmp:1823.3-1829.14 Error: operator and operand don't agree (tycon mismatch)
    operator domain: ?.Pp
    operand:         ?.Pp
    in expression:
      describe_rest pp
  bug.tmp:1874.15-1874.54 Error: operator and operand don't agree (tycon mismatch)
    operator domain: ?.Pp
    operand:         ?.Pp
    in expression:
      describe_problem (stdpp ())
  [closing bug.tmp]


  --------------------------------------------------------------------------
  (* and here's the offending file...  Sorry it's a bit long *)

  signature WR = sig

  type Wr

  val to_stdout: unit -> Wr
  val to_file: string -> Wr
  val to_nowhere: unit -> Wr
  val to_wrs: Wr list -> Wr
  val to_fn: (string->unit) -> (unit->unit) -> Wr
  val to_string: unit -> Wr
  val extract_str: Wr -> string

  val close: Wr -> unit

  val write_wr: Wr -> string -> unit

  end
  signature PP = sig

  structure Wr: WR

  type Pp

  val pp_from_wr: Wr.Wr -> Pp
  val wr_from_pp: Pp -> Wr.Wr;

  val pwrite : Pp -> string -> unit
  val setb: Pp -> unit
  val endb: Pp -> unit
  val break: Pp -> bool -> int -> unit
  val expbreak: Pp -> bool -> string -> unit
  val set_margin: Pp -> int -> unit

  val DEBUG: bool ref

  end
  signature WRMGT = sig

  (* Maintains a notion of a current (prettyprinting) writer 
     and its associated prettyprinter *)

  structure Wr: WR;
  structure Pp: PP;
  sharing Pp.Wr = Wr;

  val set_current_wr: Wr.Wr -> unit;
  val get_current_wr: unit -> Wr.Wr;
  val stdpp: unit -> Pp.Pp;

  val write: string -> unit;

  end
  signature STRINGUTILS = sig

  end
  signature REGISTRY = sig

  type registeredtype

  val register: string -> (registeredtype->unit) -> unit
  val registerflag: string -> (registeredtype ref) -> unit

  val set_flag: string -> registeredtype -> unit
  val set_all: registeredtype -> unit

  end
  signature LISTUTILS = sig

  val memq: ('a -> 'a -> bool) -> 'a list -> 'a -> bool

  val mapappend: ('a -> 'b list) -> ('a list) -> ('b list)
  val mapunit: ('a -> 'b) -> ('a list) -> unit
  val mapunit_tuple: ('a -> unit) -> (unit -> unit) -> ('a list) -> unit

  val mapfold: ('a -> 'b) -> ('b -> 'b -> 'b) -> 'b -> ('a list) -> 'b
  val forall: ('a -> bool) -> ('a list) -> bool
  val forsome: ('a -> bool) -> ('a list) -> bool

  val filter: ('a -> bool) -> ('a list) -> ('a list)

  end
  signature ID = sig

  type T 

  val intern: string -> T
  val tostr: T -> string

  val hashcode: T -> int 
  val new: unit -> T
  val new_from: T -> T

  val == : T -> T -> bool

  end

  (* May eventually want to support these too:

     val lexlt : T -> T -> bool
  *)

  signature DEBUGUTILS = sig

  val wrap: (bool ref) -> string -> (unit -> 'a) -> (unit -> unit) -> ('a -> unit) -> 'a

  end
  signature GLOBALS = sig

  structure Wr: WR
  structure Pp: PP
  structure WrMgt: WRMGT
  structure Id: ID

  sharing Pp.Wr = Wr
  sharing WrMgt.Pp = Pp

  include WRMGT

  include LISTUTILS
  include STRINGUTILS
  include DEBUGUTILS
  include REGISTRY

  sharing type registeredtype = bool

  exception CantHappen

  end
  signature TYPPVT = sig

  structure Globals: GLOBALS
  open Globals

  datatype pretyp = 
	      PRETVAR of Id.T
	    | PREARROW of pretyp * pretyp
	    | PREALL of Id.T * pretyp * pretyp
	    | PREMEET of pretyp list

  datatype T = 
	      TVAR of unit * int
	    | ARROW of unit * T * T
	    | ALL of {name:Id.T} * T * T
	    | MEET of unit * (T list)

  datatype tenvelt = BND of Id.T * T
		   | ABB of Id.T * T
		   | VBND of Id.T * T

  datatype tenv = TENV of tenvelt list

  val empty_tenv: tenv
  val push_bound: tenv -> Id.T -> T -> tenv
  val push_abbrev: tenv -> Id.T -> T -> tenv
  val push_binding: tenv -> Id.T -> T -> tenv
  val pop: tenv -> tenv

  val index: tenv -> Id.T -> int
  val lookup_name: tenv -> int -> Id.T
  val lookup_and_relocate_bound: tenv -> int -> T
  val lookup_and_relocate_binding: tenv -> int -> T
  val lookup_and_relocate: tenv -> int -> tenvelt
  val lookup: tenv -> int -> tenvelt
  val relocate: int -> T -> T

  (* Substitute the first arg for instances of var #0 in the second arg *)
  val tsubst_top: T -> T -> T

  exception UnknownId of string
  exception WrongKindOfId of tenv * int * string
  val debruijnify: tenv -> pretyp -> T

  val prt: Pp.Pp -> tenv -> T -> unit
  val prt_tenv: Pp.Pp -> tenv -> unit

  val NS: T

  end

  signature LEQ = sig

  structure Typ: TYPPVT
  structure Globals: GLOBALS
  sharing Globals = Typ.Globals

  val leq: Typ.tenv -> Typ.T -> Typ.T -> bool

  end

  signature LR_TABLE =
      sig
	  datatype state = STATE of int
	  datatype term = T of int
	  datatype nonterm = NT of int
	  datatype action = SHIFT of state
			  | REDUCE of int
			  | ACCEPT
			  | ERROR
	  type table

	  val numStates : table -> int
	  val describeActions : table -> state ->
				  ((term * action) list) * action
	  val describeGoto : table -> state -> (nonterm * state) list
	  val action : table -> state * term -> action
	  val goto : table -> state * nonterm -> state
	  val initialState : table -> state
	  exception Goto of state * nonterm

	  val mkLrTable : {actions : (((term * action) list) * action) list,
			   gotos : (nonterm * state) list list,
			   numStates : int,
			   initialState : state} -> table
      end

  signature TOKEN =
      sig
	  structure LrTable : LR_TABLE
	  datatype ('a,'b) token = TOKEN of LrTable.term * ('a * 'b * 'b)
	  val sameToken : ('a,'b) token * ('a,'b) token -> bool
      end

  signature PARSER_DATA =
     sig
	  (* the type of line numbers *)

	  type pos

	  (* the type of semantic values *)

	  type svalue

	   (* the type of the user-supplied argument to the parser *)
	  type arg

	  (* the intended type of the result of the parser.  This value is
	     produced by applying extract from the structure Actions to the
	     final semantic value resultiing from a parse.
	   *)

	  type result

	  structure LrTable : LR_TABLE
	  structure Token : TOKEN
	  sharing Token.LrTable = LrTable

	  (* structure Actions contains the functions which mantain the
	     semantic values stack in the parser.  Void is used to provide
	     a default value for the semantic stack.
	   *)

	  structure Actions : 
	    sig
		val actions : int * pos *
		     (LrTable.state * (svalue * pos * pos)) list * arg->
			   LrTable.nonterm * (svalue * pos * pos) *
			   ((LrTable.state *(svalue * pos * pos)) list)
		val void : svalue
		val extract : svalue -> result
	    end

	  (* structure EC contains information used to improve error
	     recovery in an error-correcting parser *)

	  structure EC :
	     sig
       val is_keyword : LrTable.term -> bool
	       val noShift : LrTable.term -> bool
	       val preferred_subst : LrTable.term -> LrTable.term list
	       val preferred_insert : LrTable.term -> bool
	       val errtermvalue : LrTable.term -> svalue
	       val showTerminal : LrTable.term -> string
	       val terms: LrTable.term list
	     end

	  (* table is the LR table for the parser *)

	  val table : LrTable.table
      end

  signature FMEET_TOKENS =
  sig
  type ('a,'b) token
  type svalue
  val T_PACK: ('a * 'a) ->(svalue,'a) token
  val T_END: ('a * 'a) ->(svalue,'a) token
  val T_OPEN: ('a * 'a) ->(svalue,'a) token
  val T_SOME: ('a * 'a) ->(svalue,'a) token
  val T_INSTALL: ('a * 'a) ->(svalue,'a) token
  val T_OBSERVE: ('a * 'a) ->(svalue,'a) token
  val T_FOR: ('a * 'a) ->(svalue,'a) token
  val T_OF: ('a * 'a) ->(svalue,'a) token
  val T_CASE: ('a * 'a) ->(svalue,'a) token
  val T_NS: ('a * 'a) ->(svalue,'a) token
  val T_IN: ('a * 'a) ->(svalue,'a) token
  val T_ALL: ('a * 'a) ->(svalue,'a) token
  val T_WITH: ('a * 'a) ->(svalue,'a) token
  val T_CHECK: ('a * 'a) ->(svalue,'a) token
  val T_DEBUG: ('a * 'a) ->(svalue,'a) token
  val T_RESET: ('a * 'a) ->(svalue,'a) token
  val T_SET: ('a * 'a) ->(svalue,'a) token
  val T_TYPE: ('a * 'a) ->(svalue,'a) token
  val T_USE: ('a * 'a) ->(svalue,'a) token
  val T_STR_CONST: ((string) * 'a * 'a) ->(svalue,'a) token
  val T_INT_CONST: ((string) * 'a * 'a) ->(svalue,'a) token
  val T_ID: ((string) * 'a * 'a) ->(svalue,'a) token
  val T_BIGLAMBDA: ('a * 'a) ->(svalue,'a) token
  val T_LAMBDA: ('a * 'a) ->(svalue,'a) token
  val T_INTER: ('a * 'a) ->(svalue,'a) token
  val T_RCURLY: ('a * 'a) ->(svalue,'a) token
  val T_LCURLY: ('a * 'a) ->(svalue,'a) token
  val T_RANGLE: ('a * 'a) ->(svalue,'a) token
  val T_LANGLE: ('a * 'a) ->(svalue,'a) token
  val T_RBRACK: ('a * 'a) ->(svalue,'a) token
  val T_LBRACK: ('a * 'a) ->(svalue,'a) token
  val T_RPAREN: ('a * 'a) ->(svalue,'a) token
  val T_LPAREN: ('a * 'a) ->(svalue,'a) token
  val T_DARROW: ('a * 'a) ->(svalue,'a) token
  val T_ARROW: ('a * 'a) ->(svalue,'a) token
  val T_AT: ('a * 'a) ->(svalue,'a) token
  val T_DOLLAR: ('a * 'a) ->(svalue,'a) token
  val T_DOUBLEEQ: ('a * 'a) ->(svalue,'a) token
  val T_EQ: ('a * 'a) ->(svalue,'a) token
  val T_APOST: ('a * 'a) ->(svalue,'a) token
  val T_COMMA: ('a * 'a) ->(svalue,'a) token
  val T_LEQ: ('a * 'a) ->(svalue,'a) token
  val T_SEMICOLON: ('a * 'a) ->(svalue,'a) token
  val T_COLON: ('a * 'a) ->(svalue,'a) token
  val T_DOT: ('a * 'a) ->(svalue,'a) token
  val T_EOF: ('a * 'a) ->(svalue,'a) token
  end
  signature FMEET_LRVALS =
  sig
  structure Tokens : FMEET_TOKENS
  structure ParserData:PARSER_DATA
  sharing type ParserData.Token.token = Tokens.token
  sharing type ParserData.svalue = Tokens.svalue
  end
  (* Externally visible aspects of the lexer and parser *)

  signature INTERFACE =
  sig

  type pos
  val line : pos ref
  val init_line : unit -> unit
  val next_line : unit -> unit
  val error : string * pos * pos -> unit

  end  (* signature INTERFACE *)

  signature TYP = sig

  structure Globals: GLOBALS
  open Globals

  datatype pretyp = 
	      PRETVAR of Id.T
	    | PREARROW of pretyp * pretyp
	    | PREALL of Id.T * pretyp * pretyp
	    | PREMEET of pretyp list

  type T

  type tenv
  val empty_tenv: tenv
  val push_bound: tenv -> Id.T -> T -> tenv
  val push_abbrev: tenv -> Id.T -> T -> tenv
  val push_binding: tenv -> Id.T -> T -> tenv
  val pop: tenv -> tenv

  exception UnknownId of string
  exception WrongKindOfId of tenv * int * string
  val debruijnify: tenv -> pretyp -> T

  val prt: Pp.Pp -> tenv -> T -> unit
  val prt_tenv: Pp.Pp -> tenv -> unit

  val NS: T

  end

  signature TRM = sig

  structure Globals: GLOBALS
  structure Typ: TYP
  sharing Typ.Globals = Globals
  open Globals

  datatype pretrm = 
	      PREVAR of Id.T
	    | PREABS of Id.T * Typ.pretyp * pretrm
	    | PREAPP of pretrm * pretrm
	    | PRETABS of Id.T * Typ.pretyp * pretrm
	    | PRETAPP of pretrm * Typ.pretyp
	    | PREFOR of Id.T * (Typ.pretyp list) * pretrm

  type T

  exception UnknownId of string
  val debruijnify: Typ.tenv -> pretrm -> T

  val prt: Pp.Pp -> Typ.tenv -> T -> unit

  end

  signature PARSERES = sig

  structure Typ : TYP
  structure Trm : TRM
  structure Globals: GLOBALS
  sharing Typ.Globals = Globals
  sharing Trm.Typ = Typ

  datatype T =
      Leq of Typ.pretyp * Typ.pretyp
    | Type_Assumption of Globals.Id.T * Typ.pretyp
    | Type_Abbrev of Globals.Id.T * Typ.pretyp
    | Term_Def of Globals.Id.T * Trm.pretrm
    | Term_Assumption of Globals.Id.T * Typ.pretyp
    | Use of string
    | Set of string * string
    | Nothing

  end 
  signature PARSE =
  sig

  structure ParseRes : PARSERES

  val file_parse: string -> ParseRes.T;
  val stream_parse: instream -> ParseRes.T;
  val top_parse: unit -> ParseRes.T;

  end  (* signature PARSE *)

  signature STREAM =
   sig type 'xa stream
       val streamify : (unit -> '_a) -> '_a stream
       val cons : '_a * '_a stream -> '_a stream
       val get : '_a stream -> '_a * '_a stream
   end

  signature PARSER =
      sig
	  structure Token : TOKEN
	  structure Stream : STREAM
	  exception ParseError

	  type pos
	  type result
	  type arg
	  type svalue

	  val makeLexer : (int -> string) ->
			   (svalue,pos) Token.token Stream.stream

	  val parse : int * ((svalue,pos) Token.token Stream.stream) *
		      (string * pos * pos -> unit) * arg ->
				  result * (svalue,pos) Token.token Stream.stream

	  val sameToken : (svalue,pos) Token.token * (svalue,pos) Token.token ->
				  bool
       end

  functor Parse (structure Globals : GLOBALS
		 structure ParseRes : PARSERES
		 structure Interface : INTERFACE
		 structure Parser : PARSER
		    sharing type Parser.pos = Interface.pos
		    sharing type Parser.result = ParseRes.T
		    sharing type Parser.arg = unit
		 structure Tokens : FMEET_TOKENS
		    sharing type Tokens.token = Parser.Token.token
		    sharing type Tokens.svalue = Parser.svalue
		 ) : PARSE =
  struct

  structure ParseRes = ParseRes
  open Globals

  val parse = fn (lookahead,reader : int -> string) =>
      let val _ = Interface.init_line()
	  val empty = !Interface.line
	  val dummyEOF = Tokens.T_EOF(empty,empty)
	  fun invoke lexer = 
	     Parser.parse(lookahead,lexer,Interface.error,())
	  fun loop lexer =
	    let val (result,lexer) = invoke lexer
		val (nextToken,lexer) = Parser.Stream.get lexer
	    in if Parser.sameToken(nextToken,dummyEOF) then result
	       else loop lexer
	    end
       in loop (Parser.makeLexer reader)
       end

  fun string_reader s =
   let val next = ref s
   in fn _ => !next before next := ""
   end

  val string_parse = fn s => parse (0, string_reader s)

  val file_parse = fn name =>
    let val dev = open_in name
     in (parse (15,(fn i => input(dev,i)))) before close_in dev
     end

  fun prefix line len = substring(line,0,min(len,size line))    

  fun echo_line line =
      if (line = "\n") orelse (line="")
	 then write line
      else if prefix line 3 = "%% "
	 then write (substring(line,3,size(line)-3))
      else if prefix line 2 = "%%"
	 then write (substring(line,2,size(line)-2))
      else write ("> " ^ line)

  fun convert_tabs s =
      implode (map (fn "\t" => "        " | s => s) (explode s));

  fun stream_parse dev =
     parse (15,(fn i => 
		   let val line = convert_tabs(input_line(dev))
		       val _ = echo_line line
		   in line
		   end))

  val top_parse = fn () => parse (0,
		  let val not_first_flag = ref(false)
		  in fn i => (( if (!not_first_flag)
			       then (write "> "; flush_out std_out)
			       else not_first_flag := true );
			      input_line std_in)
		  end)

  end  (* functor Parse *)

  signature SYNTH = sig

  structure Globals: GLOBALS
  structure Trm: TRM
  structure Typ: TYP
  structure Leq: LEQ
  sharing Trm.Typ = Typ
      and Leq.Typ = Typ
      and Typ.Globals = Globals
  open Globals

  val synth: Typ.tenv -> Trm.T -> Typ.T

  end

  functor StrgHash() =
  struct

    val prime = 8388593 (* largest prime less than 2^23 *)
    val base = 128

    fun hashString(str: string) : int =
	let val l = size str
	 in case l
	      of 0 => 0
	       | 1 => ord str
	       | 2 => ordof(str,0) + base * ordof(str,1)
	       | 3 => ordof(str,0) + base * (ordof(str,1) + base * ordof(str,2))
	       | _ =>
		  let fun loop (0,n) = n
			| loop (i,n) = 
			    let val i = i-1
				val n' = (base * n + ordof(str,i)) 
			     in loop (i, (n' - prime * (n' quot prime)))
			    end
		   in loop (l,0)
		  end
	end

  end (* structure StrgHash *)
  functor StringUtils() : STRINGUTILS = struct

  end

  signature LEXER =
     sig
	 structure UserDeclarations :
	     sig
		  type ('a,'b) token
		  type pos
		  type svalue
	     end
	  val makeLexer : (int -> string) -> unit -> 
	   (UserDeclarations.svalue,UserDeclarations.pos) UserDeclarations.token
     end

  functor FMEETLexFun(structure Tokens: FMEET_TOKENS structure Interface: INTERFACE) : LEXER=
     struct
      structure UserDeclarations =
	struct
  structure Tokens = Tokens
  structure Interface = Interface
  open Interface

  type pos = Interface.pos
  type svalue = Tokens.svalue
  type ('a,'b) token = ('a,'b) Tokens.token
  type lexresult= (svalue,pos) token

  val eof = fn () => Tokens.T_EOF(!line,!line)

  val str_begin = ref(!line);
  val str_const = ref([]:string list);

  end (* end of user routines *)
  exception LexError (* raised if illegal leaf action tried *)
  structure Internal =
	  struct

  datatype yyfinstate = N of int
  type statedata = {fin : yyfinstate list, trans: string}
  (* transition & final state table *)
  val tab = let
  val s0 =
  "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000"
  val s1 =
  "\007\007\007\007\007\007\007\007\007\097\099\007\007\007\007\007\
  \\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\
  \\097\007\007\007\096\095\007\094\093\092\007\007\091\089\088\086\
  \\084\084\084\084\084\084\084\084\084\084\083\082\080\077\076\007\
  \\075\072\010\010\010\010\010\010\010\010\010\010\010\010\070\010\
  \\010\010\010\066\010\010\010\010\010\010\010\065\063\062\007\007\
  \\061\010\010\053\048\045\042\010\010\040\010\010\010\010\010\035\
  \\031\010\026\023\019\016\010\012\010\010\010\009\007\008\007\007\
  \\007"
  val s3 =
  "\100\100\100\100\100\100\100\100\100\100\101\100\100\100\100\100\
  \\100\100\100\100\100\100\100\100\100\100\100\100\100\100\100\100\
  \\100\100\100\100\100\100\100\100\100\100\100\100\100\100\100\100\
  \\100\100\100\100\100\100\100\100\100\100\100\100\100\100\100\100\
  \\100\100\100\100\100\100\100\100\100\100\100\100\100\100\100\100\
  \\100\100\100\100\100\100\100\100\100\100\100\100\100\100\100\100\
  \\100\100\100\100\100\100\100\100\100\100\100\100\100\100\100\100\
  \\100\100\100\100\100\100\100\100\100\100\100\100\100\100\100\100\
  \\100"
  val s5 =
  "\102\102\102\102\102\102\102\102\102\102\104\102\102\102\102\102\
  \\102\102\102\102\102\102\102\102\102\102\102\102\102\102\102\102\
  \\102\102\102\102\102\102\102\102\102\102\102\102\102\102\102\102\
  \\102\102\102\102\102\102\102\102\102\102\102\102\102\102\102\102\
  \\102\102\102\102\102\102\102\102\102\102\102\102\102\102\102\102\
  \\102\102\102\102\102\102\102\102\102\102\102\102\102\102\102\102\
  \\103\102\102\102\102\102\102\102\102\102\102\102\102\102\102\102\
  \\102\102\102\102\102\102\102\102\102\102\102\102\102\102\102\102\
  \\102"
  val s10 =
  "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
  \\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\000\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\011\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\
  \\000"
  val s12 =
  "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
  \\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\000\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\011\
  \\000\011\011\011\011\011\011\011\011\013\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\
  \\000"
  val s13 =
  "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
  \\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\000\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\011\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\014\011\011\011\011\011\011\000\000\000\000\000\
  \\000"
  val s14 =
  "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
  \\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\000\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\011\
  \\000\011\011\011\011\011\011\011\015\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\
  \\000"
  val s16 =
  "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
  \\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\000\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\011\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\017\011\011\011\011\011\011\011\000\000\000\000\000\
  \\000"
  val s17 =
  "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
  \\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\000\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\011\
  \\000\011\011\011\011\018\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\
  \\000"
  val s19 =
  "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
  \\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\000\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\011\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\020\011\000\000\000\000\000\
  \\000"
  val s20 =
  "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
  \\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\000\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\011\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
  \\021\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\
  \\000"
  val s21 =
  "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
  \\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\000\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\011\
  \\000\011\011\011\011\022\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\
  \\000"
  val s23 =
  "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
  \\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\000\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\011\
  \\000\011\011\011\011\024\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\
  \\000"
  val s24 =
  "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
  \\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\000\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\011\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\025\011\011\011\011\011\011\000\000\000\000\000\
  \\000"
  val s26 =
  "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
  \\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\000\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\011\
  \\000\011\011\011\011\027\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\
  \\000"
  val s27 =
  "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
  \\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\000\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\011\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\028\011\011\011\011\011\011\011\000\000\000\000\000\
  \\000"
  val s28 =
  "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
  \\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\000\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\011\
  \\000\011\011\011\011\029\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\
  \\000"
  val s29 =
  "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
  \\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\000\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\011\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\030\011\011\011\011\011\011\000\000\000\000\000\
  \\000"
  val s31 =
  "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
  \\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\000\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\011\
  \\000\032\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\
  \\000"
  val s32 =
  "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
  \\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\000\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\011\
  \\000\011\011\033\011\011\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\
  \\000"
  val s33 =
  "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
  \\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\000\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\011\
  \\000\011\011\011\011\011\011\011\011\011\011\034\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\
  \\000"
  val s35 =
  "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
  \\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\000\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\011\
  \\000\011\011\011\011\011\039\011\011\011\011\011\011\011\011\011\
  \\036\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\
  \\000"
  val s36 =
  "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
  \\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\000\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\011\
  \\000\011\011\011\011\037\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\
  \\000"
  val s37 =
  "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
  \\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\000\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\011\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\011\038\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\
  \\000"
  val s40 =
  "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
  \\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\000\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\011\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\011\041\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\
  \\000"
  val s42 =
  "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
  \\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\000\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\011\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\043\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\
  \\000"
  val s43 =
  "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
  \\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\000\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\011\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
  \\011\011\044\011\011\011\011\011\011\011\011\000\000\000\000\000\
  \\000"
  val s45 =
  "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
  \\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\000\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\011\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\011\046\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\
  \\000"
  val s46 =
  "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
  \\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\000\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\011\
  \\000\011\011\011\047\011\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\
  \\000"
  val s48 =
  "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
  \\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\000\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\011\
  \\000\011\011\011\011\049\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\
  \\000"
  val s49 =
  "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
  \\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\000\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\011\
  \\000\011\050\011\011\011\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\
  \\000"
  val s50 =
  "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
  \\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\000\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\011\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\051\011\011\011\011\011\000\000\000\000\000\
  \\000"
  val s51 =
  "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
  \\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\000\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\011\
  \\000\011\011\011\011\011\011\052\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\
  \\000"
  val s53 =
  "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
  \\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\000\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\011\
  \\000\058\011\011\011\011\011\011\054\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\
  \\000"
  val s54 =
  "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
  \\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\000\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\011\
  \\000\011\011\011\011\055\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\
  \\000"
  val s55 =
  "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
  \\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\000\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\011\
  \\000\011\011\056\011\011\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\
  \\000"
  val s56 =
  "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
  \\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\000\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\011\
  \\000\011\011\011\011\011\011\011\011\011\011\057\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\
  \\000"
  val s58 =
  "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
  \\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\000\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\011\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\059\011\011\011\011\011\011\011\000\000\000\000\000\
  \\000"
  val s59 =
  "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
  \\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\000\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\011\
  \\000\011\011\011\011\060\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\
  \\000"
  val s63 =
  "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\064\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000"
  val s66 =
  "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
  \\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\000\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\011\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\067\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\
  \\000"
  val s67 =
  "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
  \\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\000\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\011\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\068\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\
  \\000"
  val s68 =
  "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
  \\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\000\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\011\
  \\000\011\011\011\011\069\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\
  \\000"
  val s70 =
  "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
  \\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\000\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\071\011\011\011\011\011\011\011\000\000\000\000\011\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\
  \\000"
  val s72 =
  "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
  \\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\000\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\011\
  \\000\011\011\011\011\011\011\011\011\011\011\011\073\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\
  \\000"
  val s73 =
  "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\
  \\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\000\
  \\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\011\
  \\000\011\011\011\011\011\011\011\011\011\011\011\074\011\011\011\
  \\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\
  \\000"
  val s77 =
  "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\079\078\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000"
  val s80 =
  "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\081\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000"
  val s84 =
  "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\085\085\085\085\085\085\085\085\085\085\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000"
  val s86 =
  "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\087\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000"
  val s89 =
  "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\090\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000"
  val s97 =
  "\000\000\000\000\000\000\000\000\000\098\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\098\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
  \\000"
  in arrayoflist
  [{fin = [], trans = s0},
  {fin = [(N 32)], trans = s1},
  {fin = [(N 32)], trans = s1},
  {fin = [], trans = s3},
  {fin = [], trans = s3},
  {fin = [], trans = s5},
  {fin = [], trans = s5},
  {fin = [(N 144)], trans = s0},
  {fin = [(N 80),(N 144)], trans = s0},
  {fin = [(N 78),(N 144)], trans = s0},
  {fin = [(N 137),(N 144)], trans = s10},
  {fin = [(N 137)], trans = s10},
  {fin = [(N 137),(N 144)], trans = s12},
  {fin = [(N 137)], trans = s13},
  {fin = [(N 137)], trans = s14},
  {fin = [(N 91),(N 137)], trans = s10},
  {fin = [(N 137),(N 144)], trans = s16},
  {fin = [(N 137)], trans = s17},
  {fin = [(N 3),(N 137)], trans = s10},
  {fin = [(N 137),(N 144)], trans = s19},
  {fin = [(N 137)], trans = s20},
  {fin = [(N 137)], trans = s21},
  {fin = [(N 8),(N 137)], trans = s10},
  {fin = [(N 137),(N 144)], trans = s23},
  {fin = [(N 137)], trans = s24},
  {fin = [(N 12),(N 137)], trans = s10},
  {fin = [(N 137),(N 144)], trans = s26},
  {fin = [(N 137)], trans = s27},
  {fin = [(N 137)], trans = s28},
  {fin = [(N 137)], trans = s29},
  {fin = [(N 18),(N 137)], trans = s10},
  {fin = [(N 137),(N 144)], trans = s31},
  {fin = [(N 137)], trans = s32},
  {fin = [(N 137)], trans = s33},
  {fin = [(N 122),(N 137)], trans = s10},
  {fin = [(N 137),(N 144)], trans = s35},
  {fin = [(N 137)], trans = s36},
  {fin = [(N 137)], trans = s37},
  {fin = [(N 117),(N 137)], trans = s10},
  {fin = [(N 99),(N 137)], trans = s10},
  {fin = [(N 137),(N 144)], trans = s40},
  {fin = [(N 129),(N 137)], trans = s10},
  {fin = [(N 137),(N 144)], trans = s42},
  {fin = [(N 137)], trans = s43},
  {fin = [(N 103),(N 137)], trans = s10},
  {fin = [(N 137),(N 144)], trans = s45},
  {fin = [(N 137)], trans = s46},
  {fin = [(N 126),(N 137)], trans = s10},
  {fin = [(N 137),(N 144)], trans = s48},
  {fin = [(N 137)], trans = s49},
  {fin = [(N 137)], trans = s50},
  {fin = [(N 137)], trans = s51},
  {fin = [(N 24),(N 137)], trans = s10},
  {fin = [(N 137),(N 144)], trans = s53},
  {fin = [(N 137)], trans = s54},
  {fin = [(N 137)], trans = s55},
  {fin = [(N 137)], trans = s56},
  {fin = [(N 30),(N 137)], trans = s10},
  {fin = [(N 137)], trans = s58},
  {fin = [(N 137)], trans = s59},
  {fin = [(N 96),(N 137)], trans = s10},
  {fin = [(N 142),(N 144)], trans = s0},
  {fin = [(N 72),(N 144)], trans = s0},
  {fin = [(N 134),(N 144)], trans = s63},
  {fin = [(N 132)], trans = s0},
  {fin = [(N 70),(N 144)], trans = s0},
  {fin = [(N 137),(N 144)], trans = s66},
  {fin = [(N 137)], trans = s67},
  {fin = [(N 137)], trans = s68},
  {fin = [(N 112),(N 137)], trans = s10},
  {fin = [(N 137),(N 144)], trans = s70},
  {fin = [(N 86),(N 137)], trans = s10},
  {fin = [(N 137),(N 144)], trans = s72},
  {fin = [(N 137)], trans = s73},
  {fin = [(N 107),(N 137)], trans = s10},
  {fin = [(N 42),(N 144)], trans = s0},
  {fin = [(N 76),(N 144)], trans = s0},
  {fin = [(N 52),(N 144)], trans = s77},
  {fin = [(N 61)], trans = s0},
  {fin = [(N 55)], trans = s0},
  {fin = [(N 74),(N 144)], trans = s80},
  {fin = [(N 58)], trans = s0},
  {fin = [(N 44),(N 144)], trans = s0},
  {fin = [(N 38),(N 144)], trans = s0},
  {fin = [(N 140),(N 144)], trans = s84},
  {fin = [(N 140)], trans = s84},
  {fin = [(N 144)], trans = s86},
  {fin = [(N 64)], trans = s0},
  {fin = [(N 46),(N 144)], trans = s0},
  {fin = [(N 144)], trans = s89},
  {fin = [(N 83)], trans = s0},
  {fin = [(N 48),(N 144)], trans = s0},
  {fin = [(N 68),(N 144)], trans = s0},
  {fin = [(N 66),(N 144)], trans = s0},
  {fin = [(N 50),(N 144)], trans = s0},
  {fin = [(N 36),(N 144)], trans = s0},
  {fin = [(N 40),(N 144)], trans = s0},
  {fin = [(N 32),(N 144)], trans = s97},
  {fin = [(N 32)], trans = s97},
  {fin = [(N 34)], trans = s0},
  {fin = [(N 148)], trans = s0},
  {fin = [(N 146)], trans = s0},
  {fin = [(N 154)], trans = s0},
  {fin = [(N 152),(N 154)], trans = s0},
  {fin = [(N 150)], trans = s0}]
  end
  structure StartStates =
	  struct
	  datatype yystartstate = STARTSTATE of int

  (* start state definitions *)

  val COMMENT = STARTSTATE 3;
  val INITIAL = STARTSTATE 1;
  val STRING = STARTSTATE 5;

  end
  type result = UserDeclarations.lexresult
	  exception LexerError (* raised if illegal leaf action tried *)
  end

  fun makeLexer yyinput = 
  let 
	  val yyb = ref "\n" 		(* buffer *)
	  val yybl = ref 1		(*buffer length *)
	  val yybufpos = ref 1		(* location of next character to use *)
	  val yygone = ref 1		(* position in file of beginning of buffer *)
	  val yydone = ref false		(* eof found yet? *)
	  val yybegin = ref 1		(*Current 'start state' for lexer *)

	  val YYBEGIN = fn (Internal.StartStates.STARTSTATE x) =>
		   yybegin := x

  fun lex () : Internal.result =
  let fun continue() = lex() in
    let fun scan (s,AcceptingLeaves : Internal.yyfinstate list list,l,i0) =
	  let fun action (i,nil) = raise LexError
	  | action (i,nil::l) = action (i-1,l)
	  | action (i,(node::acts)::l) =
		  case node of
		      Internal.N yyk => 
			  (let val yytext = substring(!yyb,i0,i-i0)
			       val yypos = i0+ !yygone
			  open UserDeclarations Internal.StartStates
   in (yybufpos := i; case yyk of 

			  (* Application actions *)

    103 => (Tokens.T_FOR(!line,!line))
  | 107 => (Tokens.T_ALL(!line,!line))
  | 112 => (Tokens.T_SOME(!line,!line))
  | 117 => (Tokens.T_OPEN(!line,!line))
  | 12 => (Tokens.T_SET(!line,!line))
  | 122 => (Tokens.T_PACK(!line,!line))
  | 126 => (Tokens.T_END (!line,!line))
  | 129 => (Tokens.T_IN(!line,!line))
  | 132 => (Tokens.T_BIGLAMBDA(!line,!line))
  | 134 => (Tokens.T_LAMBDA(!line,!line))
  | 137 => (Tokens.T_ID (yytext,!line,!line))
  | 140 => (Tokens.T_INT_CONST (yytext,!line,!line))
  | 142 => (str_begin:=(!line); str_const:=[]; YYBEGIN STRING; lex())
  | 144 => (error ("ignoring illegal character" ^ yytext,
			     !line,!line); lex())
  | 146 => (next_line(); YYBEGIN INITIAL; lex())
  | 148 => (lex())
  | 150 => (next_line(); lex())
  | 152 => (YYBEGIN INITIAL;
		      Tokens.T_STR_CONST(implode(rev(!str_const)),
					 !str_begin,!line))
  | 154 => (str_const:=(yytext::(!str_const)); lex())
  | 18 => (Tokens.T_RESET(!line,!line))
  | 24 => (Tokens.T_DEBUG(!line,!line))
  | 3 => (Tokens.T_USE(!line,!line))
  | 30 => (Tokens.T_CHECK(!line,!line))
  | 32 => (lex())
  | 34 => (next_line(); lex())
  | 36 => (YYBEGIN COMMENT; lex())
  | 38 => (Tokens.T_COLON(!line,!line))
  | 40 => (Tokens.T_DOLLAR(!line,!line))
  | 42 => (Tokens.T_AT(!line,!line))
  | 44 => (Tokens.T_EOF(!line,!line))
  | 46 => (Tokens.T_DOT(!line,!line))
  | 48 => (Tokens.T_COMMA(!line,!line))
  | 50 => (Tokens.T_APOST(!line,!line))
  | 52 => (Tokens.T_EQ(!line,!line))
  | 55 => (Tokens.T_DOUBLEEQ(!line,!line))
  | 58 => (Tokens.T_LEQ(!line,!line))
  | 61 => (Tokens.T_DARROW(!line,!line))
  | 64 => (Tokens.T_INTER(!line,!line))
  | 66 => (Tokens.T_LPAREN(!line,!line))
  | 68 => (Tokens.T_RPAREN(!line,!line))
  | 70 => (Tokens.T_LBRACK(!line,!line))
  | 72 => (Tokens.T_RBRACK(!line,!line))
  | 74 => (Tokens.T_LANGLE(!line,!line))
  | 76 => (Tokens.T_RANGLE(!line,!line))
  | 78 => (Tokens.T_LCURLY(!line,!line))
  | 8 => (Tokens.T_TYPE(!line,!line))
  | 80 => (Tokens.T_RCURLY(!line,!line))
  | 83 => (Tokens.T_ARROW(!line,!line))
  | 86 => (Tokens.T_NS(!line,!line))
  | 91 => (Tokens.T_WITH(!line,!line))
  | 96 => (Tokens.T_CASE(!line,!line))
  | 99 => (Tokens.T_OF(!line,!line))
  | _ => raise Internal.LexerError

		  ) end )

	  val {fin,trans} = Internal.tab sub s
	  val NewAcceptingLeaves = fin::AcceptingLeaves
	  in if l = !yybl then
	       if trans = #trans(Internal.tab sub 0)
		 then action(l,NewAcceptingLeaves) else
	      let val newchars= if !yydone then "" else yyinput 1024
	      in if (size newchars)=0
		    then (yydone := true;
			  if (l=i0) then UserDeclarations.eof ()
				    else action(l,NewAcceptingLeaves))
		    else (if i0=l then yyb := newchars
		       else yyb := substring(!yyb,i0,l-i0)^newchars;
		       yygone := !yygone+i0;
		       yybl := size (!yyb);
		       scan (s,AcceptingLeaves,l-i0,0))
	      end
	    else let val NewChar = ordof(!yyb,l)
		  val NewState = if NewChar<128 then ordof(trans,NewChar) else ordof(trans,128)
		  in if NewState=0 then action(l,NewAcceptingLeaves)
		  else scan(NewState,NewAcceptingLeaves,l+1,i0)
	  end
	  end
	  in scan(!yybegin (* start *),nil,!yybufpos,!yybufpos)
      end
  end
    in lex
    end
  end
  functor Registry(
	      type registeredtype
	      ): REGISTRY = struct

  type registeredtype = registeredtype

  val registry = ref(nil: (string * (registeredtype->unit)) list)

  fun register name callback = 
    registry := (name,callback)::(!registry)

  fun registerflag name flagref =
    registry := (name,(fn b => flagref := b))::(!registry)

  exception NotRegistered of string

  fun set_flag name v = 
    let fun f [] = raise NotRegistered(name)
	  | f ((n,callback)::tl) = if name=n 
				     then (callback v)
				     else f tl
    in f (!registry)
    end

  fun set_all v =
    let fun f [] = ()
	  | f ((n,callback)::tl) = (callback v; f tl)
    in f (!registry)
    end

  end
  functor Typ(
	      structure Globals: GLOBALS
	      ) : TYPPVT
	      = struct

  structure Globals = Globals
  open Globals
  open Pp

  datatype pretyp = 
	      PRETVAR of Id.T
	    | PREARROW of pretyp * pretyp
	    | PREALL of Id.T * pretyp * pretyp
	    | PREMEET of pretyp list

  datatype T = 
	      TVAR of unit * int
	    | ARROW of unit * T * T
	    | ALL of {name:Id.T} * T * T
	    | MEET of unit * (T list)

  type idindex = int

  val NS = MEET ((),[])

  exception UnknownId of string

  datatype tenvelt = BND of Id.T * T
		   | ABB of Id.T * T
		   | VBND of Id.T * T

  datatype tenv = TENV of tenvelt list

  fun push_bound (TENV(te)) i t = TENV(BND(i,t)::te)

  fun push_abbrev (TENV(te)) i t = TENV(ABB(i,t)::te)

  fun push_binding (TENV(te)) i t = TENV(VBND(i,t)::te)

  val empty_tenv = TENV(nil)

  fun index (TENV(bvs)) i =
    let fun ind [] n =
	      raise UnknownId(Id.tostr i)
	  | ind (BND(i',_)::rest) n =
	      if Id.== i i'
		 then n
		 else ind rest (n+1)
	  | ind (VBND(i',_)::rest) n =
	      if Id.== i i'
		 then n
		 else ind rest (n+1)
	  | ind (ABB(i',_)::rest) n =
	      if Id.== i i'
		 then n
		 else ind rest (n+1)
    in ind bvs 0
    end

  exception TypeVariableOutOfRange of int

  fun old_lookup_name (TENV(te)) i = 
    (case (nth (te,i)) of
      BND(name,_) => name
    | VBND(name,_) => name
    | ABB(name,_) => name)
    handle Nth => Id.intern(("<BAD INDEX: " ^ (makestring i) ^ ">"))

  fun lookup_name (TENV(te)) i = 
    let fun l [] _ _ = Id.intern(("<BAD INDEX: " ^ (makestring i) ^ ">"))
	  | l (hd::tl) rest 0 = 
	      let val name = case hd of BND(n,_) => n | VBND(n,_) => n | ABB(n,_) => n
	      in if memq Id.== rest name 
		   then Id.intern ((Id.tostr name) ^ "^" ^ (makestring i))
		   else name
	      end
	  | l (hd::tl) rest j = 
	      let val name = case hd of BND(n,_) => n | VBND(n,_) => n | ABB(n,_) => n
	      in l tl (name::rest) (j-1)
	      end
    in l te [] i
    end

  exception WrongKindOfId of tenv * int * string

  fun lookup (TENV(te)) i =
    nth (te,i)
    handle Nth => raise TypeVariableOutOfRange(i)

  exception TriedToPopEmptyTEnv
  fun pop (TENV(hd::tl)) = TENV(tl)
    | pop _ = raise TriedToPopEmptyTEnv

  fun inner_relocate offset cutoff t =
    let fun r c (TVAR((),i)) = if i>=c 
				  then TVAR((),i + offset)
				  else TVAR((),i)
	  | r c (ARROW((),t1,t2)) = ARROW((), r c t1, r c t2)
	  | r c (ALL({name=i},t1,t2)) = ALL({name=i}, r c t1, r (c+1) t2)
	  | r c (MEET((),ts)) = MEET((), map (fn t => r c t) ts)
    in r cutoff t
    end

  fun relocate offset t = inner_relocate offset 0 t

  fun lookup_and_relocate (te) i =
    case lookup te i of
      BND(n,b) => BND(n, relocate (i+1) b)
    | VBND(n,b) => VBND(n, relocate (i+1) b)
    | ABB(n,b) => ABB(n, relocate (i+1) b)

  fun lookup_and_relocate_bound te i = 
    case lookup_and_relocate te i of
      BND(_,b) => b
    | VBND(n,_) => raise WrongKindOfId(te,i,"tvar")
    | ABB(n,_) => raise WrongKindOfId(te,i,"tvar")

  fun lookup_and_relocate_binding te i = 
    case lookup_and_relocate te i of
      BND(n,b) => raise WrongKindOfId(te,i,"var")
    | VBND(n,b) => b
    | ABB(n,b) => raise WrongKindOfId(te,i,"var")

  fun lookup_abbrev te i = 
    case lookup_and_relocate te i of
      BND(n,_) => raise WrongKindOfId(te,i,"tabbrev")
    | VBND(n,b) => raise WrongKindOfId(te,i,"tabbrev")
    | ABB(n,b) => b

  fun debruijnify te (PRETVAR i) =
	TVAR((), index te i)
    | debruijnify te (PREARROW (pt1,pt2)) =
	ARROW((), debruijnify te pt1, debruijnify te pt2)
    | debruijnify te (PREALL (i,pt1,pt2)) =
	ALL({name=i}, debruijnify te pt1, debruijnify (push_bound te i NS) pt2)
    | debruijnify te (PREMEET pts) =
	MEET((), map (fn pt => debruijnify te pt) pts)

  fun tsubst_top targ tbody =
    let fun s i (t as TVAR(x,i')) = if i = i' 
				      then relocate i targ
				    else if i < i'
				      then TVAR(x,i'-1)
				    else t
	  | s i (ARROW(x,t1,t2)) = ARROW(x, s i t1, s i t2)
	  | s i (ALL(x,t1,t2)) = ALL(x, s i t1, s (i+1) t2)
	  | s i (MEET(x,ts)) = MEET(x, map (fn t => s i t) ts)
    in s 0 tbody 
    end

  fun prt pp te t =
    let fun p te (TVAR(_,i)) =
		Pp.pwrite pp (Id.tostr (lookup_name te i))
	  | p te (ARROW(_,t1,t2)) =
		(Pp.pwrite pp "(";
		 p te t1;
		 Pp.pwrite pp "->";
		 p te t2;
		 Pp.pwrite pp ")")
	  | p te (ALL({name=i},t1,t2)) =
		(Pp.pwrite pp "(All ";
		 Pp.pwrite pp (Id.tostr i);
		 Pp.pwrite pp "<=";
		 p te t1;
		 Pp.pwrite pp ". ";
		 p (push_bound te i t1) t2;
		 Pp.pwrite pp ")")
	  | p te (MEET(_,[])) =
		 Pp.pwrite pp "NS"
	  | p te (MEET(_,ts)) =
		(Pp.pwrite pp "/\\[";
		 plist te ts;
		 Pp.pwrite pp "]")
	and plist te [] = 
	      ()
	  | plist te [t] = 
	      p te t
	  | plist te (hd::tl) = 
	      (p te hd; pwrite pp ","; plist te tl)
    in p te t
    end

  val short_tenvs = ref(true);
  val _ = registerflag "shorttenvs" short_tenvs;

  fun prt_tenv pp (TENV(te')) =
    let fun p [] = ()
	  | p [(BND(i,t))] = 
	      (Pp.pwrite pp (Id.tostr i);
	       Pp.pwrite pp "<=";
	       prt pp (TENV([])) t)
	  | p ((BND(i,t))::tl) = 
	      (if (!short_tenvs)
		 then pwrite pp "... "
		 else p tl; 
	       Pp.pwrite pp ", ";
	       Pp.break pp false 0;
	       Pp.pwrite pp (Id.tostr i);
	       Pp.pwrite pp "<=";
	       prt pp (TENV(tl)) t)
	  | p [(VBND(i,t))] = 
	      (Pp.pwrite pp (Id.tostr i);
	       Pp.pwrite pp ":";
	       prt pp (TENV([])) t)
	  | p ((VBND(i,t))::tl) = 
	      (if (!short_tenvs)
		 then pwrite pp "... "
		 else p tl; 
	       Pp.pwrite pp ", ";
	       Pp.break pp false 0;
	       Pp.pwrite pp (Id.tostr i);
	       Pp.pwrite pp ":";
	       prt pp (TENV(tl)) t)
	  | p [(ABB(i,t))] = 
	      (Pp.pwrite pp (Id.tostr i);
	       Pp.pwrite pp "=";
	       prt pp (TENV([])) t)
	  | p ((ABB(i,t))::tl) = 
	      (if (!short_tenvs)
		 then pwrite pp "... "
		 else p tl; 
	       Pp.pwrite pp ", ";
	       Pp.break pp false 0;
	       Pp.pwrite pp (Id.tostr i);
	       Pp.pwrite pp "=";
	       prt pp (TENV(tl)) t)
    in Pp.pwrite pp "{";
       Pp.setb pp;
       p te';
       Pp.endb pp;
       Pp.pwrite pp "}"
    end

  end
  functor Leq(
	    structure Typ: TYPPVT
	    structure Globals: GLOBALS
	    sharing Typ.Globals = Globals
	    ) : LEQ = struct

  structure Typ = Typ
  structure Globals = Globals
  open Globals
  open Typ

  datatype lhsqueue = 
	      ARROW_LHS of Typ.T
	    | ALL_LHS   of Id.T * Typ.T

  datatype rhs_flag = EXPAND | FIX

  val DEBUG = ref(false)
  val _ = (registerflag "leq" DEBUG;
	   registerflag "Leq" DEBUG)

  fun describe_rest pp te [] t flag = 
	(Pp.pwrite pp "] -> ";
	 Typ.prt pp te t;
	 case flag of
	   EXPAND => Pp.pwrite pp " (EXPAND)?  "
	 | FIX    => Pp.pwrite pp " (FIX)?  ")
    | describe_rest pp te [ARROW_LHS(t1)] t2 flag = 
	(Typ.prt pp te t1;
	 describe_rest pp te [] t2 flag)
    | describe_rest pp te ((ARROW_LHS(t1))::X2) t2 flag = 
	(Typ.prt pp te t1;
	 Pp.pwrite pp ",";
	 describe_rest pp te X2 t2 flag)
    | describe_rest pp te [ALL_LHS(v,t1)] t2 flag = 
	(Pp.pwrite pp (Id.tostr v);
	 Pp.pwrite pp "<=";
	 Typ.prt pp te t1;
	 describe_rest pp (push_bound te v t1) [] t2 flag)
    | describe_rest pp te ((ALL_LHS(v,t1))::X2) t2 flag = 
	(Pp.pwrite pp (Id.tostr v);
	 Pp.pwrite pp "<=";
	 Typ.prt pp te t1;
	 Pp.pwrite pp ",";
	 describe_rest pp (push_bound te v t1) X2 t2 flag)

  fun describe_problem pp te s X t flag =
    (Pp.setb pp;
     Typ.prt pp te s;
     Pp.break pp true ~3;
     Pp.pwrite pp " <= ";
     Pp.pwrite pp "[";
     describe_rest pp te X t flag;
     Pp.endb pp)

  fun bindings_in [] = 0
    | bindings_in (ARROW_LHS(_)::tl) = bindings_in tl
    | bindings_in (ALL_LHS(_)::tl) = 1 + (bindings_in tl)

  fun leqq' te s X (MEET(_,ts)) EXPAND =
	forall (fn t => leqq te s X t EXPAND) ts
    | leqq' te s X (ARROW(_,t1,t2)) EXPAND =
	leqq te s (X@[ARROW_LHS(t1)]) t2 EXPAND
    | leqq' te s X (ALL({name=i},t1,t2)) EXPAND =
	leqq te s (X@[ALL_LHS(i,t1)]) t2 EXPAND
    | leqq' te s X (t as TVAR(_,vt)) EXPAND =
	let val bx = bindings_in X
	in if vt < bx
	   then leqq te s X t FIX
	   else case Typ.lookup te (vt - bx) of 
		 BND(_,_)  => leqq te s X t FIX
	       | VBND(n,_)  => raise Typ.WrongKindOfId(te, vt - bx,"tvar or tabbrev")
	       | ABB(_,ab) => leqq te s X (Typ.relocate (vt + bx) ab) EXPAND
	end
    | leqq' te (MEET(_,ss)) X (t as (TVAR(_,vt))) FIX =
	forsome (fn s => leqq te s X t FIX) ss
    | leqq' te (ARROW(_,s1,s2)) (ARROW_LHS(t1)::X) (t as (TVAR(_,vt))) FIX =
	(leqq te t1 [] s1 EXPAND)
	andalso
	(leqq te s2 X t FIX)
    | leqq' te (ALL(_,s1,s2)) (ALL_LHS(i,t1)::X) (t as (TVAR(_,vt))) FIX =
	(leqq (push_bound te i t1) s2 X t FIX)
	andalso
	(leqq te t1 [] s1 EXPAND)
    | leqq' te (TVAR(_,vs)) X (t as (TVAR(_,vt))) FIX =
	(vs = vt andalso (null X))
	orelse
	(case lookup_and_relocate te vs of
	   BND(_,bnd) => (leqq te bnd X t FIX)
	 | VBND(n,ab)  => raise Typ.WrongKindOfId(te,vs,"tvar or tabbrev")
	 | ABB(_,ab)  => (leqq te ab X t FIX))
    | leqq' te s X t flag =
	false

  and leqq te s X t flag =
    wrap DEBUG "leqq"
      (fn () => 
	leqq' te s X t flag)
      (fn () => describe_problem (stdpp()) te s X t flag)
      (fn b => write (if b then "Yes" else "No"))

  fun leq te s t = leqq te s [] t EXPAND

  end

  functor HashFun () = struct

  val version = 1.0

  type ('a,'b) table = ('a*'a->bool) * (('a*int*'b) list array) * int

  fun create (sample'key :'1a) (equality :'1a * '1a -> bool)
	     table'size (sample'value :'1b) :('1a,'1b) table =
    let val mt = tl [(sample'key, 0, sample'value)]
    in (equality, array (table'size, mt), table'size)
    end

  val defaultSize = 97 (* a prime; or try primes 37, 997 *)

  fun defaultEqual ((x :string), (y :string)) :bool = (x = y)

  fun createDefault (sample'value :'1b) :(string,'1b) table =
    let val mt = tl [("", 0, sample'value)]
    in (defaultEqual, array (defaultSize, mt), defaultSize)
    end

  fun enter ((equal, table, table'size) :('a,'b) table) key hash value = 
    let val place = hash mod table'size
	val bucket = table sub place
	fun put'in [] = [(key,hash,value)]
	  | put'in ((k,h,v)::tail) =
	      if (h = hash) andalso equal (k, key)
		then (key,hash,value)::tail
		else (k,h,v)::(put'in tail)
    in
      update (table, place, put'in bucket)
    end

  fun remove ((equal, table, table'size) :('a,'b) table) key hash =
    let val place = hash mod table'size
	val bucket = table sub place
	fun take'out [] = []
	  | take'out ((k,h,v)::tail) =
	      if (h = hash) andalso equal (k, key)
		then tail
		else (k,h,v)::(take'out tail)
    in
      update (table, place, take'out bucket)
    end

  fun lookup ((equal, table, table'size) :('a,'b) table) key hash =
    let val place = hash mod table'size
	val bucket = table sub place
	fun get'out [] = NONE
	  | get'out ((k,h,v)::tail) =
	      if (h = hash) andalso equal (k, key)
		then SOME v
		else get'out tail
    in
      get'out bucket
    end

  fun print ((_, table, table'size) :('a,'b) table)
	    (print'key :'a -> unit) (print'value :'b -> unit) =
    let fun pr'bucket [] = ()
	  | pr'bucket ((key,hash,value)::rest) =
	      (print'key key; String.print ": ";
	       Integer.print hash; String.print ": ";
	       print'value value; String.print "\n"; pr'bucket rest)
	fun pr i =
	  if i >= table'size then ()
	    else
	      case (table sub i) of
		 [] => (pr (i+1))
	       | (b as (h::t)) =>
		   (String.print "["; Integer.print i; String.print "]\n";
		    pr'bucket b; pr (i+1))
    in pr 0 end

  fun scan ((_, table, table'size) :('a,'b) table) operation =
    let fun map'bucket [] = ()
	  | map'bucket ((key,hash,value)::rest) =
	      (operation key hash value; map'bucket rest)
	fun iter i =
	  if i >= table'size then ()
	    else (map'bucket (table sub i); iter (i+1))
    in iter 0 end

  fun fold ((_, table, table'size) :('a, 'b) table)
	   (operation :'a -> int -> 'b -> 'g -> 'g) (init :'g) :'g =
    let fun fold'bucket [] acc = acc
	  | fold'bucket ((key,hash,value)::rest) acc =
	       fold'bucket rest (operation key hash value acc)
	fun iter i acc =
	  if i >= table'size then acc
	    else iter (i+1) (fold'bucket (table sub i) acc)
    in iter 0 init end

  fun scanUpdate ((_, table, table'size) :('a,'b) table) operation =
    let fun map'bucket [] = []
	  | map'bucket ((key,hash,value)::rest) =
	      ((key,hash,operation key hash value)::(map'bucket rest))
	fun iter i =
	  if i >= table'size then ()
	    else (update (table, i, map'bucket (table sub i)); iter (i+1))
    in iter 0 end

  fun eliminate ((_, table, table'size) :('a,'b) table) predicate =
    let fun map'bucket [] = []
	  | map'bucket ((key,hash,value)::rest) =
	      if predicate key hash value then map'bucket rest
		else (key,hash,value)::(map'bucket rest)
	fun iter i =
	  if i >= table'size then ()
	    else (update (table, i, map'bucket (table sub i)); iter (i+1))
    in iter 0 end

  fun bucketLengths ((_, table, table'size) :('a,'b) table) (maxlen :int)
      :int array =
    let val count :int array = array (maxlen+1, 0)
	fun inc'sub x = 
	  let val y = min (x, maxlen) in
	    update (count, y, (count sub y) + 1)
	  end
	fun iter i =
	  if i >= table'size then ()
	    else (inc'sub (length (table sub i)); iter (i+1))
    in
      iter 0;
      count
    end

  end

  signature ORDSET =
     sig
	type set
	type elem
	exception Select_arb
	val app : (elem -> 'b) -> set -> unit
	    and card: set -> int
	    and closure: set * (elem -> set) -> set
	    and difference: set * set -> set
	    and elem_eq: (elem * elem -> bool)
	    and elem_gt : (elem * elem -> bool)
	    and empty: set
	    and exists: (elem * set) -> bool
	    and find : (elem * set)  ->  elem option
	    and fold: ((elem * 'b) -> 'b) -> set -> 'b -> 'b
	    and insert: (elem * set) -> set
	    and is_empty: set -> bool
	    and make_list: set -> elem list
	    and make_set: (elem list -> set)
	    and partition: (elem -> bool) -> (set -> set * set)
	    and remove: (elem * set) -> set
	    and revfold: ((elem * 'b) -> 'b) -> set -> 'b -> 'b
	    and select_arb: set -> elem
	    and set_eq: (set * set) -> bool
	    and set_gt: (set * set) -> bool
	    and singleton: (elem -> set)
	    and union: set * set -> set
     end

  signature TABLE =
     sig
	  type 'a table
	  type key
	  val size : 'a table -> int
	  val empty: 'a table
	  val exists: (key * 'a table) -> bool
	  val find : (key * 'a table)  ->  'a option
	  val insert: ((key * 'a) * 'a table) -> 'a table
	  val make_table : (key * 'a ) list -> 'a table
	  val make_list : 'a table -> (key * 'a) list
	  val fold : ((key * 'a) * 'b -> 'b) -> 'a table -> 'b -> 'b
     end

  signature HASH =
    sig
      type table
      type elem

      val size : table -> int
      val add : elem * table -> table
      val find : elem * table -> int option
      val exists : elem * table -> bool
      val empty : table
    end;

  functor ListOrdSet(B : sig type elem
			  val gt : elem * elem -> bool
			  val eq : elem * elem -> bool
		      end ) : ORDSET =

  struct
   type elem = B.elem
   val elem_gt = B.gt
   val elem_eq = B.eq 

   type set = elem list
   exception Select_arb
   val empty = nil

   val insert = fn (key,s) =>
	  let fun f (l as (h::t)) =
		   if elem_gt(key,h) then h::(f t)
		   else if elem_eq(key,h) then key::t
		   else key::l
		| f nil = [key]
	  in f s
	  end

   val select_arb = fn nil => raise Select_arb
		     | a::b => a

   val exists = fn (key,s) =>
	  let fun f (h::t) = if elem_gt(key,h) then f t
			     else elem_eq(h,key) 
		| f nil = false
	  in f s
	  end

   val find = fn (key,s) =>
	  let fun f (h::t) = if elem_gt(key,h) then f t
			     else if elem_eq(h,key) then SOME h
			     else NONE
		| f nil = NONE
	  in f s
	  end

   val revfold = List.revfold
   val fold = List.fold
   val app = List.app

  fun set_eq(h::t,h'::t') = 
	  (case elem_eq(h,h')
	    of true => set_eq(t,t')
	     | a => a)
    | set_eq(nil,nil) = true
    | set_eq _ = false

  fun set_gt(h::t,h'::t') =
	  (case elem_gt(h,h')
	    of false => (case (elem_eq(h,h'))
			  of true => set_gt(t,t')
			   | a => a)
	     |  a => a)
    | set_gt(_::_,nil) = true
    | set_gt _ = false

  fun union(a as (h::t),b as (h'::t')) =
	    if elem_gt(h',h) then h::union(t,b)
	    else if elem_eq(h,h') then h::union(t,t')
	    else h'::union(a,t')
    | union(nil,s) = s
    | union(s,nil) = s

  val make_list = fn s => s

  val is_empty = fn nil => true | _ => false

  val make_set = fn l => List.fold insert l nil

  val partition = fn f => fn s =>
      fold (fn (e,(yes,no)) =>
	      if (f e) then (e::yes,no) else (e::no,yes)) s (nil,nil)

  val remove = fn (e,s) =>
      let fun f (l as (h::t)) = if elem_gt(h,e) then l
				else if elem_eq(h,e) then t
				else h::(f t)
	    | f nil = nil
      in f s
      end

   (* difference: X-Y *)

   fun difference (nil,_) = nil
     | difference (r,nil) = r
     | difference (a as (h::t),b as (h'::t')) =
	    if elem_gt (h',h) then h::difference(t,b)
	    else if elem_eq(h',h) then difference(t,t')
	    else difference(a,t')

   fun singleton X = [X]

   fun card(S) = fold (fn (a,count) => count+1) S 0

	local
	      fun closure'(from, f, result) =
		if is_empty from then result
		else
		  let val (more,result) =
			  fold (fn (a,(more',result')) =>
				  let val more = f a
				      val new = difference(more,result)
				  in (union(more',new),union(result',new))
				  end) from
				   (empty,result)
		  in closure'(more,f,result)
		  end
	in
	   fun closure(start, f) = closure'(start, f, start)
	end
  end

  functor RbOrdSet (B : sig type elem
			   val eq : (elem*elem) -> bool
			   val gt : (elem*elem) -> bool
		       end
		  ) : ORDSET =
  struct

   type elem = B.elem
   val elem_gt = B.gt
   val elem_eq = B.eq 

   datatype Color = RED | BLACK

   abstype set = EMPTY | TREE of (B.elem * Color * set * set)
   with exception Select_arb
	val empty = EMPTY

   fun insert(key,t) =
    let fun f EMPTY = TREE(key,RED,EMPTY,EMPTY)
	  | f (TREE(k,BLACK,l,r)) =
	      if elem_gt (key,k)
	      then case f r
		   of r as TREE(rk,RED, rl as TREE(rlk,RED,rll,rlr),rr) =>
			  (case l
			   of TREE(lk,RED,ll,lr) =>
				  TREE(k,RED,TREE(lk,BLACK,ll,lr),
					     TREE(rk,BLACK,rl,rr))
			    | _ => TREE(rlk,BLACK,TREE(k,RED,l,rll),
						  TREE(rk,RED,rlr,rr)))
		    | r as TREE(rk,RED,rl, rr as TREE(rrk,RED,rrl,rrr)) =>
			  (case l
			   of TREE(lk,RED,ll,lr) =>
				  TREE(k,RED,TREE(lk,BLACK,ll,lr),
					     TREE(rk,BLACK,rl,rr))
			    | _ => TREE(rk,BLACK,TREE(k,RED,l,rl),rr))
		    | r => TREE(k,BLACK,l,r)
	      else if elem_gt(k,key)
	      then case f l
		   of l as TREE(lk,RED,ll, lr as TREE(lrk,RED,lrl,lrr)) =>
			  (case r
			   of TREE(rk,RED,rl,rr) =>
				  TREE(k,RED,TREE(lk,BLACK,ll,lr),
					     TREE(rk,BLACK,rl,rr))
			    | _ => TREE(lrk,BLACK,TREE(lk,RED,ll,lrl),
						  TREE(k,RED,lrr,r)))
		    | l as TREE(lk,RED, ll as TREE(llk,RED,lll,llr), lr) =>
			  (case r
			   of TREE(rk,RED,rl,rr) =>
				  TREE(k,RED,TREE(lk,BLACK,ll,lr),
					     TREE(rk,BLACK,rl,rr))
			    | _ => TREE(lk,BLACK,ll,TREE(k,RED,lr,r)))
		    | l => TREE(k,BLACK,l,r)
	      else TREE(key,BLACK,l,r)
	  | f (TREE(k,RED,l,r)) =
	      if elem_gt(key,k) then TREE(k,RED,l, f r)
	      else if elem_gt(k,key) then TREE(k,RED, f l, r)
	      else TREE(key,RED,l,r)
     in case f t
	of TREE(k,RED, l as TREE(_,RED,_,_), r) => TREE(k,BLACK,l,r)
	 | TREE(k,RED, l, r as TREE(_,RED,_,_)) => TREE(k,BLACK,l,r)
	 | t => t
    end

   fun select_arb (TREE(k,_,l,r)) = k
     | select_arb EMPTY = raise Select_arb

   fun exists(key,t) =
    let fun look EMPTY = false
	  | look (TREE(k,_,l,r)) =
		  if elem_gt(k,key) then look l
		  else if elem_gt(key,k) then look r
		  else true
     in look t
     end

   fun find(key,t) =
    let fun look EMPTY = NONE
	  | look (TREE(k,_,l,r)) =
		  if elem_gt(k,key) then look l
		  else if elem_gt(key,k) then look r
		  else SOME k
     in look t
    end

    fun revfold f t start =
       let fun scan (EMPTY,value) = value
	     | scan (TREE(k,_,l,r),value) = scan(r,f(k,scan(l,value)))
       in scan(t,start)
       end

     fun fold f t start =
	  let fun scan(EMPTY,value) = value
		| scan(TREE(k,_,l,r),value) = scan(l,f(k,scan(r,value)))
	  in scan(t,start)
	  end

     fun app f t =
	let fun scan EMPTY = ()
	      | scan(TREE(k,_,l,r)) = (scan l; f k; scan r)
	in scan t
	end


     fun set_eq (tree1 as (TREE _),tree2 as (TREE _)) =
       let datatype pos = L | R | M
	   exception Done
	   fun getvalue(stack as ((a,position)::b)) =
	      (case a
	       of (TREE(k,_,l,r)) =>
		  (case position
		   of L => getvalue ((l,L)::(a,M)::b)
		    | M => (k,case r of  EMPTY => b | _ => (a,R)::b)
		    | R => getvalue ((r,L)::b)
		   )
		| EMPTY => getvalue b
	       )
	      | getvalue(nil) = raise Done
	    fun f (nil,nil) = true
	      | f (s1 as (_ :: _),s2 as (_ :: _ )) =
			    let val (v1,news1) = getvalue s1
				and (v2,news2) = getvalue s2
			    in (elem_eq(v1,v2)) andalso f(news1,news2)
			    end
	      | f _ = false
	in f ((tree1,L)::nil,(tree2,L)::nil) handle Done => false
	end
      | set_eq (EMPTY,EMPTY) = true
      | set_eq _ = false


     fun set_gt (tree1,tree2) =
       let datatype pos = L | R | M
	   exception Done
	   fun getvalue(stack as ((a,position)::b)) =
	      (case a
	       of (TREE(k,_,l,r)) =>
		  (case position
		   of L => getvalue ((l,L)::(a,M)::b)
		    | M => (k,case r of EMPTY => b | _ => (a,R)::b)
		    | R => getvalue ((r,L)::b)
		   )
		| EMPTY => getvalue b
	       )
	      | getvalue(nil) = raise Done
	    fun f (nil,nil) = false
	      | f (s1 as (_ :: _),s2 as (_ :: _ )) =
			    let val (v1,news1) = getvalue s1
				and (v2,news2) = getvalue s2
			    in (elem_gt(v1,v2)) orelse (elem_eq(v1,v2) andalso f(news1,news2))
			    end
	      | f (_,nil) = true
	      | f (nil,_) = false
	in f ((tree1,L)::nil,(tree2,L)::nil) handle Done => false
	end

	fun is_empty S = (let val _ = select_arb S in false end
			   handle Select_arb => true)

	fun make_list S = fold (op ::) S nil

	fun make_set l = List.fold insert l empty

	fun partition F S = fold (fn (a,(Yes,No)) =>
				  if F(a) then (insert(a,Yes),No)
				  else (Yes,insert(a,No)))
			       S (empty,empty)

	fun remove(X, XSet) =
	       let val (YSet, _) =
			  partition (fn a => not (elem_eq (X, a))) XSet
	       in  YSet
	       end

	fun difference(Xs, Ys) =
	     fold (fn (p as (a,Xs')) =>
			if exists(a,Ys) then Xs' else insert p)
	     Xs empty

	fun singleton X = insert(X,empty)

	fun card(S) = fold (fn (_,count) => count+1) S 0

	fun union(Xs,Ys)= fold insert Ys Xs

	local
	      fun closure'(from, f, result) =
		if is_empty from then result
		else
		  let val (more,result) =
			  fold (fn (a,(more',result')) =>
				  let val more = f a
				      val new = difference(more,result)
				  in (union(more',new),union(result',new))
				  end) from
				   (empty,result)
		  in closure'(more,f,result)
		  end
	in
	   fun closure(start, f) = closure'(start, f, start)
	end
     end
  end


  functor Table (B : sig type key
			val gt : (key * key) -> bool
		       end
		  ) : TABLE =
  struct

   datatype Color = RED | BLACK
   type key = B.key

   abstype 'a table = EMPTY
		    | TREE of ((B.key * 'a ) * Color * 'a table * 'a table)
   with

   val empty = EMPTY

   fun insert(elem as (key,data),t) =
    let val key_gt = fn (a,_) => B.gt(key,a)
	val key_lt = fn (a,_) => B.gt(a,key)
	  fun f EMPTY = TREE(elem,RED,EMPTY,EMPTY)
	  | f (TREE(k,BLACK,l,r)) =
	      if key_gt k
	      then case f r
		   of r as TREE(rk,RED, rl as TREE(rlk,RED,rll,rlr),rr) =>
			  (case l
			   of TREE(lk,RED,ll,lr) =>
				  TREE(k,RED,TREE(lk,BLACK,ll,lr),
					     TREE(rk,BLACK,rl,rr))
			    | _ => TREE(rlk,BLACK,TREE(k,RED,l,rll),
						  TREE(rk,RED,rlr,rr)))
		    | r as TREE(rk,RED,rl, rr as TREE(rrk,RED,rrl,rrr)) =>
			  (case l
			   of TREE(lk,RED,ll,lr) =>
				  TREE(k,RED,TREE(lk,BLACK,ll,lr),
					     TREE(rk,BLACK,rl,rr))
			    | _ => TREE(rk,BLACK,TREE(k,RED,l,rl),rr))
		    | r => TREE(k,BLACK,l,r)
	      else if key_lt k
	      then case f l
		   of l as TREE(lk,RED,ll, lr as TREE(lrk,RED,lrl,lrr)) =>
			  (case r
			   of TREE(rk,RED,rl,rr) =>
				  TREE(k,RED,TREE(lk,BLACK,ll,lr),
					     TREE(rk,BLACK,rl,rr))
			    | _ => TREE(lrk,BLACK,TREE(lk,RED,ll,lrl),
						  TREE(k,RED,lrr,r)))
		    | l as TREE(lk,RED, ll as TREE(llk,RED,lll,llr), lr) =>
			  (case r
			   of TREE(rk,RED,rl,rr) =>
				  TREE(k,RED,TREE(lk,BLACK,ll,lr),
					     TREE(rk,BLACK,rl,rr))
			    | _ => TREE(lk,BLACK,ll,TREE(k,RED,lr,r)))
		    | l => TREE(k,BLACK,l,r)
	      else TREE(elem,BLACK,l,r)
	  | f (TREE(k,RED,l,r)) =
	      if key_gt k then TREE(k,RED,l, f r)
	      else if key_lt k then TREE(k,RED, f l, r)
	      else TREE(elem,RED,l,r)
     in case f t
	of TREE(k,RED, l as TREE(_,RED,_,_), r) => TREE(k,BLACK,l,r)
	 | TREE(k,RED, l, r as TREE(_,RED,_,_)) => TREE(k,BLACK,l,r)
	 | t => t
    end

   fun exists(key,t) =
    let fun look EMPTY = false
	  | look (TREE((k,_),_,l,r)) =
		  if B.gt(k,key) then look l
		  else if B.gt(key,k) then look r
		  else true
     in look t
     end

   fun find(key,t) =
    let fun look EMPTY = NONE
	  | look (TREE((k,data),_,l,r)) =
		  if B.gt(k,key) then look l
		  else if B.gt(key,k) then look r
		  else SOME data
     in look t
    end

    fun fold f t start =
	  let fun scan(EMPTY,value) = value
		| scan(TREE(k,_,l,r),value) = scan(l,f(k,scan(r,value)))
	  in scan(t,start)
	  end

    fun make_table l = List.fold insert l empty

    fun size S = fold (fn (_,count) => count+1) S 0

    fun make_list table = fold (op ::) table nil

    end
  end;

  functor Hash(B : sig type elem
		       val gt : elem * elem -> bool
		   end) : HASH =
  struct
      type elem=B.elem
      structure HashTable = Table(type key=B.elem
				  val gt = B.gt)

      type table = {count : int, table : int HashTable.table}

      val empty = {count=0,table=HashTable.empty}
      val size = fn {count,table} => count
      val add = fn (e,{count,table}) =>
		  {count=count+1,table=HashTable.insert((e,count),table)}
      val find = fn (e,{table,count}) => HashTable.find(e,table)
      val exists = fn (e,{table,count}) => HashTable.exists(e,table)
  end;

  functor Interface () : INTERFACE =
  struct

  type pos = int
  val line = ref 0
  fun init_line () = (line := 0)
  fun next_line () = (line := !line + 1)
  fun error (errmsg,line:pos,_) =
    output (std_out, ("Line " ^ (makestring line) ^ ": " ^ errmsg ^ "\n"))

  end  (* functor INTERFACE *)
  functor Globals(
	      structure Wr: WR
	      structure Pp: PP
	      structure WrMgt: WRMGT
	      structure ListUtils: LISTUTILS
	      structure StringUtils: STRINGUTILS
	      structure DebugUtils: DEBUGUTILS
	      structure Id: ID
	      structure Registry: REGISTRY
	      sharing Pp.Wr = Wr
		  and WrMgt.Pp = Pp
		  and type Registry.registeredtype = bool
	      ) : GLOBALS 
	      = struct

  structure Wr = Wr;
  open Wr;

  structure Pp = Pp;
  open Pp;

  structure WrMgt = WrMgt;
  open WrMgt;

  structure Id = Id;

  structure Registry = Registry

  open ListUtils
  open StringUtils
  open DebugUtils
  open Registry

  exception CantHappen

  end

  signature TRMPVT = sig

  structure Globals: GLOBALS
  structure Typ: TYPPVT
  sharing Typ.Globals = Globals
  open Globals

  datatype pretrm = 
	      PREVAR of Id.T
	    | PREABS of Id.T * Typ.pretyp * pretrm
	    | PREAPP of pretrm * pretrm
	    | PRETABS of Id.T * Typ.pretyp * pretrm
	    | PRETAPP of pretrm * Typ.pretyp
	    | PREFOR of Id.T * (Typ.pretyp list) * pretrm

  datatype T = 
	      VAR of unit * int
	    | ABS of {name:Id.T} * Typ.T * T
	    | APP of unit * T * T
	    | TABS of {name:Id.T} * Typ.T * T
	    | TAPP of unit * T * Typ.T
	    | FOR of {name:Id.T} * (Typ.T list) * T

  exception UnknownId of string
  val debruijnify: Typ.tenv -> pretrm -> T

  val prt: Pp.Pp -> Typ.tenv -> T -> unit

  end

  functor DebugUtils(
	      structure WrMgt: WRMGT
	      ) : DEBUGUTILS = struct

  open WrMgt
  open Pp;

  val level = ref(0);

  (* $$$ belongs in globals: *)
  fun unwind_protect f cleanup =
    (f())
    handle e => (cleanup(); raise e)

  fun do_wrap pp name f pbefore pafter =
    (pwrite pp "[";
     setb pp;  
     pwrite pp (makestring (!level));
     pwrite pp "] ";
     pwrite pp name;
     pwrite pp "? ";
     pbefore();
     pwrite pp "\n";
     level := (!level) + 1;
     let val result = unwind_protect 
			  f
			  (fn () => level := (!level) - 1)
     in
	level := (!level) - 1;
	break pp true ~3;
	pwrite pp "   [";
	pwrite pp (makestring (!level));
	pwrite pp "] ";
	pwrite pp name;
	pwrite pp ": ";
	pafter(result);
	pwrite pp "\n";
	endb pp;
	result
     end
    )

  fun wrap DEBUG name f pbefore pafter =
    if (not (!DEBUG))
      then f()
      else do_wrap (stdpp()) name f pbefore pafter;

  end
  functor Trm(
	      structure Globals: GLOBALS
	      structure Typ: TYPPVT
	      sharing Typ.Globals = Globals
	      ) : TRMPVT
	      = struct

  structure Globals = Globals
  structure Typ = Typ
  open Globals
  open Typ
  open Pp

  datatype pretrm = 
	      PREVAR of Id.T
	    | PREABS of Id.T * pretyp * pretrm
	    | PREAPP of pretrm * pretrm
	    | PRETABS of Id.T * pretyp * pretrm
	    | PRETAPP of pretrm * pretyp
	    | PREFOR of Id.T * (pretyp list) * pretrm

  datatype T = 
	      VAR of unit * int
	    | ABS of {name:Id.T} * Typ.T * T
	    | APP of unit * T * T
	    | TABS of {name:Id.T} * Typ.T * T
	    | TAPP of unit * T * Typ.T
	    | FOR of {name:Id.T} * (Typ.T list) * T

  fun debruijnify te (PREVAR i) =
	VAR((), index te i)
    | debruijnify te (PREABS(i,ptyp,ptrm)) =
	ABS({name=i}, Typ.debruijnify te ptyp, 
		      debruijnify (push_binding te i NS) ptrm)
    | debruijnify te (PREAPP(ptrm1,ptrm2)) =
	APP((), debruijnify te ptrm1, debruijnify te ptrm2)
    | debruijnify te (PRETABS(i,ptyp,ptrm)) =
	TABS({name=i}, Typ.debruijnify te ptyp, 
		       debruijnify (push_bound te i NS) ptrm)
    | debruijnify te (PRETAPP(ptrm,ptyp)) =
	TAPP((), debruijnify te ptrm, Typ.debruijnify te ptyp)
    | debruijnify te (PREFOR(i,ptyps,ptrm)) =
	FOR({name=i}, map (fn pt => Typ.debruijnify te pt) ptyps, 
		       debruijnify (push_bound te i NS) ptrm)

  fun prt pp te trm =
    let fun p te (VAR(_,i)) =
		Pp.pwrite pp (Id.tostr (lookup_name te i))
	  | p te (ABS({name=i},t,body)) =
		(Pp.pwrite pp "(\\";
		 Pp.pwrite pp (Id.tostr i);
		 Pp.pwrite pp ":";
		 Typ.prt pp te t;
		 Pp.pwrite pp ". ";
		 p (push_binding te i t) body;
		 Pp.pwrite pp ")")
	  | p te (APP(_,trm1,trm2)) =
		(Pp.pwrite pp "(";
		 p te trm1;
		 Pp.pwrite pp " ";
		 p te trm2;
		 Pp.pwrite pp ")")
	  | p te (TABS({name=i},t,body)) =
		(Pp.pwrite pp "(\\\\";
		 Pp.pwrite pp (Id.tostr i);
		 Pp.pwrite pp "<=";
		 Typ.prt pp te t;
		 Pp.pwrite pp ". ";
		 p (push_bound te i t) body;
		 Pp.pwrite pp ")")
	  | p te (TAPP(_,trm1,t)) =
		(Pp.pwrite pp "(";
		 p te trm1;
		 Pp.pwrite pp " [";
		 Typ.prt pp te t;
		 Pp.pwrite pp "])")
	  | p te (FOR({name=i},ts,body)) =
		(Pp.pwrite pp "(for ";
		 Pp.pwrite pp (Id.tostr i);
		 Pp.pwrite pp " in ";
		 mapunit_tuple (fn t => Typ.prt pp te t) (fn () => Pp.pwrite pp ",") ts;
		 Pp.pwrite pp ". ";
		 p (push_abbrev te i NS) body;
		 Pp.pwrite pp ")")
    in p te trm
    end

  end
  functor ListUtils() : LISTUTILS = struct

  fun mapunit f l = 
    let fun mu [] = ()
	  | mu (hd::tl) = (f hd; mu tl)
    in mu l
    end

  fun mapunit_tuple f betw ts =
    let fun mut [] = ()
	  | mut [e] = f e
	  | mut (e::tl) = (f e; betw(); mut tl)
    in mut ts
    end

  fun mapfold fm ff z =
    let fun m []       = z
	  | m (hd::tl) = ff (fm hd) (m tl)
    in m
    end

  fun memq eq l e =
    let fun m [] = false
	  | m (hd::tl) = (eq e hd) orelse (m tl)
    in m l
    end

  fun mapappend f l =
    let fun ma [] = []
	  | ma (hd::tl) = (f hd) @ (ma tl)
    in ma l
    end

  fun filter b l =
    let fun f [] = []
	  | f (hd::tl) = if (b hd) then hd::(f tl) else f tl
    in f l
    end

  fun forall f = mapfold f (fn x => fn y => x andalso y) true

  fun forsome f = mapfold f (fn x => fn y => x orelse y) false

  end
  functor Synth(
	      structure Globals: GLOBALS
	      structure Typ: TYPPVT
	      structure Trm: TRMPVT
	      structure Leq: LEQ
	      sharing Typ.Globals = Globals
		  and Trm.Typ = Typ
		  and Leq.Typ = Typ
	      ) : SYNTH = struct

  structure Globals = Globals
  structure Typ = Typ
  structure Trm = Trm
  structure Leq = Leq
  open Globals
  open Typ
  open Trm

  val DEBUG = ref(false)
  val _ = (registerflag "synth" DEBUG;
	   registerflag "Synth" DEBUG)

  fun arrowbasis te t = 
    let fun ab (TVAR(_,v)) = 
	      (case lookup_and_relocate te v of
		  BND(_,b) => ab b
		| VBND(n,b) => raise Typ.WrongKindOfId(te,v,"tvar or abbrev")
		| ABB(_,b) => ab b)
	  | ab (t as ARROW(_)) =
	      [t]
	  | ab (ALL(_)) =
	      []
	  | ab (MEET(_,ts)) =
	      mapappend ab ts
    in ab t
    end

  fun allbasis te t = 
    let fun ab (TVAR(_,v)) = 
	      (case lookup_and_relocate te v of
		  BND(_,b) => ab b
		| VBND(n,b) => raise Typ.WrongKindOfId(te,v,"tvar or abbrev")
		| ABB(_,b) => ab b)
	  | ab (t as ARROW(_)) =
	      []
	  | ab (t as ALL(_)) =
	      [t]
	  | ab (MEET(_,ts)) =
	      mapappend ab ts
    in ab t
    end

  fun synth' te (VAR(_,v)) = Typ.lookup_and_relocate_binding te v
    | synth' te (ABS({name=i},t,body)) = 
	let val t_body = synth (push_binding te i t) body
	    val t' = relocate ~1 t_body
	in ARROW((),t,t')
	end
    | synth' te (APP(_,trm1,trm2)) = 
	let val t1 = synth te trm1
	    and t2 = synth te trm2
	    val basis = arrowbasis te t1
	    fun collect_apps [] =
		  []
	      | collect_apps ((ARROW(_,tb1,tb2))::tl) = 
		  if Leq.leq te t2 tb1
		     then tb2::(collect_apps tl)
		     else (collect_apps tl)
	      | collect_apps _ = raise CantHappen
	    val ts = collect_apps basis
	in MEET((),ts)
	end
    | synth' te (TABS({name=i},t,body)) = 
	let val t' = synth (push_bound te i t) body
	in ALL({name=i},t,t')
	end
    | synth' te (TAPP(_,body,t)) =
	let val t_body = synth te body
	    val basis = allbasis te t_body
	    fun collect_apps [] =
		  []
	      | collect_apps ((ALL(_,t1,t2))::tl) = 
		  if Leq.leq te t t1
		     then (tsubst_top t t2)::(collect_apps tl)
		     else (collect_apps tl)
	      | collect_apps _ = raise CantHappen
	    val ts = collect_apps basis
	in MEET((),ts)
	end
    | synth' te (FOR({name=i},ts,body)) =
	let fun f t = 
		let val tb = synth (push_abbrev te i t) body
		    val tb' = tsubst_top t tb
		in tb'
		end
	in MEET((), map f ts)
	end

  and synth te e =
    wrap (DEBUG) "synth"
	 (fn () => synth' te e)
	 (fn () => 
	    (Trm.prt (stdpp()) te e;
	     Pp.pwrite (stdpp()) "\n";
	     Typ.prt_tenv (stdpp()) te))
	 (fn t => 
	    (Typ.prt (stdpp()) te t))

  end

  functor FMEETLrValsFun ( structure Token : TOKEN
				  structure Globals : GLOBALS
				  structure ParseRes : PARSERES
				) : FMEET_LRVALS = 
  struct
  structure ParserData=
  struct
  structure Header = 
  struct
  structure ParseRes = ParseRes
  open ParseRes
  open Trm
  open Typ
  open Globals

  end
  structure LrTable = Token.LrTable
  structure Token = Token
  local open LrTable in 
  val table=let val actionT =
  "\
  \\001\000\022\000\014\000\021\000\023\000\020\000\
  \\024\000\019\000\025\000\018\000\026\000\017\000\027\000\016\000\
  \\028\000\015\000\029\000\014\000\030\000\013\000\031\000\012\000\
  \\032\000\011\000\033\000\010\000\040\000\009\000\000\000\001\000\
  \\000\000\141\000\
  \\014\000\025\000\016\000\024\000\025\000\018\000\000\000\140\000\
  \\000\000\116\000\
  \\000\000\147\000\
  \\005\000\028\000\008\000\027\000\009\000\026\000\000\000\137\000\
  \\000\000\118\000\
  \\025\000\018\000\000\000\001\000\
  \\014\000\037\000\022\000\036\000\025\000\018\000\
  \\035\000\035\000\037\000\034\000\043\000\033\000\000\000\001\000\
  \\025\000\038\000\000\000\001\000\
  \\025\000\039\000\000\000\001\000\
  \\025\000\040\000\000\000\001\000\
  \\025\000\018\000\000\000\001\000\
  \\025\000\042\000\000\000\001\000\
  \\000\000\139\000\
  \\000\000\138\000\
  \\000\000\136\000\
  \\025\000\018\000\000\000\001\000\
  \\025\000\018\000\000\000\001\000\
  \\014\000\021\000\023\000\020\000\024\000\019\000\
  \\025\000\018\000\026\000\017\000\027\000\016\000\040\000\009\000\000\000\001\000\
  \\000\000\117\000\
  \\000\000\149\000\
  \\014\000\037\000\022\000\036\000\025\000\018\000\
  \\035\000\035\000\037\000\034\000\043\000\033\000\000\000\001\000\
  \\014\000\021\000\023\000\020\000\024\000\019\000\
  \\025\000\018\000\026\000\017\000\027\000\016\000\040\000\009\000\000\000\001\000\
  \\014\000\037\000\022\000\036\000\025\000\018\000\
  \\035\000\035\000\037\000\034\000\043\000\033\000\000\000\001\000\
  \\014\000\021\000\023\000\020\000\024\000\019\000\
  \\025\000\018\000\026\000\017\000\027\000\016\000\040\000\009\000\000\000\001\000\
  \\014\000\037\000\022\000\036\000\025\000\018\000\
  \\035\000\035\000\037\000\034\000\043\000\033\000\000\000\001\000\
  \\036\000\053\000\000\000\001\000\
  \\006\000\054\000\000\000\134\000\
  \\005\000\057\000\012\000\056\000\022\000\055\000\000\000\001\000\
  \\000\000\122\000\
  \\025\000\018\000\000\000\001\000\
  \\000\000\126\000\
  \\025\000\018\000\000\000\001\000\
  \\016\000\060\000\000\000\001\000\
  \\014\000\037\000\022\000\036\000\025\000\018\000\
  \\035\000\035\000\037\000\034\000\043\000\033\000\000\000\001\000\
  \\000\000\120\000\
  \\000\000\121\000\
  \\000\000\119\000\
  \\005\000\063\000\009\000\062\000\000\000\001\000\
  \\000\000\110\000\
  \\036\000\064\000\000\000\001\000\
  \\002\000\066\000\005\000\065\000\006\000\054\000\000\000\134\000\
  \\003\000\067\000\000\000\001\000\
  \\015\000\068\000\000\000\001\000\
  \\000\000\137\000\
  \\012\000\056\000\017\000\069\000\022\000\055\000\000\000\001\000\
  \\015\000\070\000\000\000\001\000\
  \\012\000\056\000\022\000\055\000\000\000\114\000\
  \\000\000\115\000\
  \\012\000\056\000\022\000\055\000\000\000\112\000\
  \\014\000\037\000\022\000\036\000\025\000\018\000\
  \\035\000\035\000\037\000\034\000\043\000\033\000\000\000\001\000\
  \\025\000\018\000\000\000\001\000\
  \\014\000\037\000\022\000\036\000\025\000\018\000\
  \\035\000\035\000\037\000\034\000\043\000\033\000\000\000\001\000\
  \\014\000\037\000\022\000\036\000\025\000\018\000\
  \\035\000\035\000\037\000\034\000\043\000\033\000\000\000\001\000\
  \\014\000\037\000\022\000\036\000\025\000\018\000\
  \\035\000\035\000\037\000\034\000\043\000\033\000\000\000\001\000\
  \\002\000\078\000\005\000\077\000\000\000\001\000\
  \\002\000\080\000\005\000\079\000\000\000\001\000\
  \\014\000\037\000\022\000\036\000\025\000\018\000\
  \\035\000\035\000\037\000\034\000\043\000\033\000\000\000\001\000\
  \\012\000\056\000\015\000\082\000\022\000\055\000\000\000\001\000\
  \\014\000\037\000\022\000\036\000\025\000\018\000\
  \\035\000\035\000\037\000\034\000\043\000\033\000\000\000\001\000\
  \\014\000\037\000\022\000\036\000\025\000\018\000\
  \\035\000\035\000\037\000\034\000\043\000\033\000\000\000\001\000\
  \\014\000\037\000\022\000\036\000\025\000\018\000\
  \\035\000\035\000\037\000\034\000\043\000\033\000\000\000\001\000\
  \\014\000\037\000\022\000\036\000\025\000\018\000\
  \\035\000\035\000\037\000\034\000\043\000\033\000\000\000\001\000\
  \\014\000\021\000\023\000\020\000\024\000\019\000\
  \\025\000\018\000\026\000\017\000\027\000\016\000\040\000\009\000\000\000\001\000\
  \\014\000\037\000\022\000\036\000\025\000\018\000\
  \\035\000\035\000\037\000\034\000\043\000\033\000\000\000\001\000\
  \\000\000\148\000\
  \\000\000\151\000\
  \\000\000\150\000\
  \\002\000\089\000\000\000\001\000\
  \\006\000\090\000\012\000\056\000\022\000\055\000\000\000\132\000\
  \\000\000\135\000\
  \\012\000\056\000\022\000\055\000\000\000\124\000\
  \\012\000\056\000\000\000\123\000\
  \\012\000\056\000\022\000\055\000\000\000\109\000\
  \\014\000\037\000\022\000\036\000\025\000\018\000\
  \\035\000\035\000\037\000\034\000\043\000\033\000\000\000\001\000\
  \\014\000\037\000\022\000\036\000\025\000\018\000\
  \\035\000\035\000\037\000\034\000\043\000\033\000\000\000\001\000\
  \\014\000\037\000\022\000\036\000\025\000\018\000\
  \\035\000\035\000\037\000\034\000\043\000\033\000\000\000\001\000\
  \\014\000\037\000\022\000\036\000\025\000\018\000\
  \\035\000\035\000\037\000\034\000\043\000\033\000\000\000\001\000\
  \\017\000\095\000\000\000\001\000\
  \\000\000\127\000\
  \\012\000\056\000\022\000\055\000\000\000\113\000\
  \\012\000\056\000\022\000\055\000\000\000\111\000\
  \\002\000\096\000\000\000\001\000\
  \\002\000\097\000\012\000\056\000\022\000\055\000\000\000\001\000\
  \\000\000\143\000\
  \\002\000\098\000\000\000\001\000\
  \\014\000\021\000\023\000\020\000\024\000\019\000\
  \\025\000\018\000\026\000\017\000\027\000\016\000\040\000\009\000\000\000\001\000\
  \\014\000\037\000\022\000\036\000\025\000\018\000\
  \\035\000\035\000\037\000\034\000\043\000\033\000\000\000\001\000\
  \\002\000\101\000\012\000\056\000\022\000\055\000\000\000\001\000\
  \\012\000\056\000\022\000\055\000\000\000\130\000\
  \\002\000\102\000\012\000\056\000\022\000\055\000\000\000\001\000\
  \\012\000\056\000\022\000\055\000\000\000\128\000\
  \\000\000\125\000\
  \\014\000\021\000\023\000\020\000\024\000\019\000\
  \\025\000\018\000\026\000\017\000\027\000\016\000\040\000\009\000\000\000\001\000\
  \\014\000\021\000\023\000\020\000\024\000\019\000\
  \\025\000\018\000\026\000\017\000\027\000\016\000\040\000\009\000\000\000\001\000\
  \\014\000\021\000\023\000\020\000\024\000\019\000\
  \\025\000\018\000\026\000\017\000\027\000\016\000\040\000\009\000\000\000\001\000\
  \\000\000\146\000\
  \\000\000\133\000\
  \\014\000\037\000\022\000\036\000\025\000\018\000\
  \\035\000\035\000\037\000\034\000\043\000\033\000\000\000\001\000\
  \\014\000\037\000\022\000\036\000\025\000\018\000\
  \\035\000\035\000\037\000\034\000\043\000\033\000\000\000\001\000\
  \\000\000\145\000\
  \\000\000\144\000\
  \\000\000\142\000\
  \\012\000\056\000\022\000\055\000\000\000\131\000\
  \\012\000\056\000\022\000\055\000\000\000\129\000\
  \\001\000\000\000\004\000\000\000\000\000\001\000\
  \"
  val gotoT =
  "\
  \\001\000\106\000\002\000\006\000\003\000\005\000\
  \\005\000\004\000\008\000\003\000\009\000\002\000\010\000\001\000\000\000\000\000\
  \\000\000\000\000\
  \\003\000\021\000\000\000\000\000\
  \\000\000\000\000\
  \\000\000\000\000\
  \\000\000\000\000\
  \\000\000\000\000\
  \\003\000\028\000\004\000\027\000\000\000\000\000\
  \\003\000\030\000\006\000\029\000\000\000\000\000\
  \\000\000\000\000\
  \\000\000\000\000\
  \\000\000\000\000\
  \\003\000\039\000\000\000\000\000\
  \\000\000\000\000\
  \\000\000\000\000\
  \\000\000\000\000\
  \\000\000\000\000\
  \\003\000\042\000\004\000\041\000\000\000\000\000\
  \\003\000\043\000\000\000\000\000\
  \\003\000\045\000\005\000\004\000\008\000\044\000\
  \\009\000\002\000\010\000\001\000\000\000\000\000\
  \\000\000\000\000\
  \\000\000\000\000\
  \\003\000\030\000\006\000\046\000\000\000\000\000\
  \\003\000\045\000\005\000\004\000\008\000\047\000\
  \\009\000\002\000\010\000\001\000\000\000\000\000\
  \\003\000\030\000\006\000\048\000\000\000\000\000\
  \\003\000\045\000\005\000\004\000\008\000\049\000\
  \\009\000\002\000\010\000\001\000\000\000\000\000\
  \\003\000\030\000\006\000\050\000\000\000\000\000\
  \\000\000\000\000\
  \\000\000\000\000\
  \\000\000\000\000\
  \\000\000\000\000\
  \\003\000\056\000\000\000\000\000\
  \\000\000\000\000\
  \\003\000\057\000\000\000\000\000\
  \\000\000\000\000\
  \\003\000\030\000\006\000\059\000\000\000\000\000\
  \\000\000\000\000\
  \\000\000\000\000\
  \\000\000\000\000\
  \\000\000\000\000\
  \\000\000\000\000\
  \\000\000\000\000\
  \\000\000\000\000\
  \\000\000\000\000\
  \\000\000\000\000\
  \\000\000\000\000\
  \\000\000\000\000\
  \\000\000\000\000\
  \\000\000\000\000\
  \\000\000\000\000\
  \\000\000\000\000\
  \\003\000\030\000\006\000\070\000\007\000\069\000\000\000\000\000\
  \\003\000\028\000\004\000\071\000\000\000\000\000\
  \\003\000\030\000\006\000\072\000\000\000\000\000\
  \\003\000\030\000\006\000\073\000\000\000\000\000\
  \\003\000\030\000\006\000\074\000\000\000\000\000\
  \\000\000\000\000\
  \\000\000\000\000\
  \\003\000\030\000\006\000\070\000\007\000\079\000\000\000\000\000\
  \\000\000\000\000\
  \\003\000\030\000\006\000\081\000\000\000\000\000\
  \\003\000\030\000\006\000\082\000\000\000\000\000\
  \\003\000\030\000\006\000\070\000\007\000\083\000\000\000\000\000\
  \\003\000\030\000\006\000\084\000\000\000\000\000\
  \\003\000\045\000\005\000\004\000\008\000\085\000\
  \\009\000\002\000\010\000\001\000\000\000\000\000\
  \\003\000\030\000\006\000\070\000\007\000\086\000\000\000\000\000\
  \\000\000\000\000\
  \\000\000\000\000\
  \\000\000\000\000\
  \\000\000\000\000\
  \\000\000\000\000\
  \\000\000\000\000\
  \\000\000\000\000\
  \\000\000\000\000\
  \\000\000\000\000\
  \\003\000\030\000\006\000\089\000\000\000\000\000\
  \\003\000\030\000\006\000\090\000\000\000\000\000\
  \\003\000\030\000\006\000\091\000\000\000\000\000\
  \\003\000\030\000\006\000\092\000\000\000\000\000\
  \\000\000\000\000\
  \\000\000\000\000\
  \\000\000\000\000\
  \\000\000\000\000\
  \\000\000\000\000\
  \\000\000\000\000\
  \\000\000\000\000\
  \\000\000\000\000\
  \\003\000\045\000\005\000\004\000\008\000\097\000\
  \\009\000\002\000\010\000\001\000\000\000\000\000\
  \\003\000\030\000\006\000\070\000\007\000\098\000\000\000\000\000\
  \\000\000\000\000\
  \\000\000\000\000\
  \\000\000\000\000\
  \\000\000\000\000\
  \\000\000\000\000\
  \\003\000\045\000\005\000\004\000\008\000\101\000\
  \\009\000\002\000\010\000\001\000\000\000\000\000\
  \\003\000\045\000\005\000\004\000\008\000\102\000\
  \\009\000\002\000\010\000\001\000\000\000\000\000\
  \\003\000\045\000\005\000\004\000\008\000\103\000\
  \\009\000\002\000\010\000\001\000\000\000\000\000\
  \\000\000\000\000\
  \\000\000\000\000\
  \\003\000\030\000\006\000\104\000\000\000\000\000\
  \\003\000\030\000\006\000\105\000\000\000\000\000\
  \\000\000\000\000\
  \\000\000\000\000\
  \\000\000\000\000\
  \\000\000\000\000\
  \\000\000\000\000\
  \\000\000\000\000\
  \"
  val numstates = 107
  val string_to_int = fn(s,index) => (ordof(s,index) + 
			  ordof(s,index+1)*256,index+2)
	  val convert_string_to_row = fn (conv_key,conv_entry) =>
	       fn(s,index) =>
		  let fun f (r,index) =
			  let val (num,index) = string_to_int(s,index)
			      val (i,index) = string_to_int(s,index)
			  in if num=0 then ((rev r,conv_entry i),index)
			     else f((conv_key (num-1),conv_entry i)::r,index)
			  end
		  in f(nil,index)
		  end
	   val convert_string_to_row_list = fn conv_funcs => fn s =>
		      let val convert_row =convert_string_to_row conv_funcs
			  fun f(r,index) =
			    if index < String.length s then
			      let val (newlist,index) = convert_row (s,index)
			      in f(newlist::r,index)
			      end
			    else rev r
		      in f(nil,0)
		      end
	   val entry_to_action = fn j =>
			 if j=0 then ACCEPT
			 else if j=1 then ERROR
			 else if j >= (numstates+2) then REDUCE (j-numstates-2)
			 else SHIFT (STATE (j-2))
	   val make_goto_table = convert_string_to_row_list(NT,STATE)
	   val make_action_table=convert_string_to_row_list(T,entry_to_action)
	   val gotoT = map (fn (a,b) => a) (make_goto_table gotoT)
	   val actionT = make_action_table actionT
       in LrTable.mkLrTable {actions=actionT,gotos=gotoT,
	    numStates=numstates,initialState=STATE 0}
       end
  end
  local open Header in
  type pos = int
  type arg = unit
  structure MlyValue = 
  struct
  datatype svalue = VOID | ntVOID of unit | T_STR_CONST of  (string)
   | T_INT_CONST of  (string) | T_ID of  (string)
   | bnd of  (ParseRes.Trm.pretrm) | appl of  (ParseRes.Trm.pretrm)
   | term of  (ParseRes.Trm.pretrm)
   | tplist of  (ParseRes.Typ.pretyp list)
   | tp of  (ParseRes.Typ.pretyp) | const of  (Id.T)
   | idlist of  (Id.T list) | id of  (Id.T) | setcmd of  (ParseRes.T)
   | start of  (ParseRes.T)
  end
  type svalue = MlyValue.svalue
  type result = ParseRes.T
  end
  structure EC=
  struct
  open LrTable
  val is_keyword =
  fn _ => false
  val preferred_insert =
  fn (T 1) => true | (T 38) => true | _ => false
  val preferred_subst =
  fn  _ => nil
  val noShift = 
  fn (T 3) => true | (T 0) => true | _ => false
  val showTerminal =
  fn (T 0) => "T_EOF"
    | (T 1) => "T_DOT"
    | (T 2) => "T_COLON"
    | (T 3) => "T_SEMICOLON"
    | (T 4) => "T_LEQ"
    | (T 5) => "T_COMMA"
    | (T 6) => "T_APOST"
    | (T 7) => "T_EQ"
    | (T 8) => "T_DOUBLEEQ"
    | (T 9) => "T_DOLLAR"
    | (T 10) => "T_AT"
    | (T 11) => "T_ARROW"
    | (T 12) => "T_DARROW"
    | (T 13) => "T_LPAREN"
    | (T 14) => "T_RPAREN"
    | (T 15) => "T_LBRACK"
    | (T 16) => "T_RBRACK"
    | (T 17) => "T_LANGLE"
    | (T 18) => "T_RANGLE"
    | (T 19) => "T_LCURLY"
    | (T 20) => "T_RCURLY"
    | (T 21) => "T_INTER"
    | (T 22) => "T_LAMBDA"
    | (T 23) => "T_BIGLAMBDA"
    | (T 24) => "T_ID"
    | (T 25) => "T_INT_CONST"
    | (T 26) => "T_STR_CONST"
    | (T 27) => "T_USE"
    | (T 28) => "T_TYPE"
    | (T 29) => "T_SET"
    | (T 30) => "T_RESET"
    | (T 31) => "T_DEBUG"
    | (T 32) => "T_CHECK"
    | (T 33) => "T_WITH"
    | (T 34) => "T_ALL"
    | (T 35) => "T_IN"
    | (T 36) => "T_NS"
    | (T 37) => "T_CASE"
    | (T 38) => "T_OF"
    | (T 39) => "T_FOR"
    | (T 40) => "T_OBSERVE"
    | (T 41) => "T_INSTALL"
    | (T 42) => "T_SOME"
    | (T 43) => "T_OPEN"
    | (T 44) => "T_END"
    | (T 45) => "T_PACK"
    | _ => "bogus-term"
  val errtermvalue=
  let open Header in
  fn _ => MlyValue.VOID
  end
  val terms = (T 0) :: (T 1) :: (T 2) :: (T 3) :: (T 4) :: (T 5) :: (T 6
  ) :: (T 7) :: (T 8) :: (T 9) :: (T 10) :: (T 11) :: (T 12) :: (T 13)
   :: (T 14) :: (T 15) :: (T 16) :: (T 17) :: (T 18) :: (T 19) :: (T 20)
   :: (T 21) :: (T 22) :: (T 23) :: (T 27) :: (T 28) :: (T 29) :: (T 30)
   :: (T 31) :: (T 32) :: (T 33) :: (T 34) :: (T 35) :: (T 36) :: (T 37)
   :: (T 38) :: (T 39) :: (T 40) :: (T 41) :: (T 42) :: (T 43) :: (T 44)
   :: (T 45) :: nil
  end
  structure Actions =
  struct 
  exception mlyAction of int
  val actions = 
  let open Header
  in
  fn (i392,defaultPos,stack,
      (()):arg) =>
  case (i392,stack)
  of (0,(_,(MlyValue.tp (tp2),tp2left,tp2right)) :: (_,(_,T_LEQleft as 
  T_LEQ1left,T_LEQright as T_LEQ1right)) :: (_,(MlyValue.tp (tp1 as tp),
  tpleft as tp1left,tpright as tp1right)) :: (_,(_,T_CHECKleft as 
  T_CHECK1left,T_CHECKright as T_CHECK1right)) :: rest671) =>
  let val result = 
  MlyValue.start (((Leq(tp1,tp2))))
  in (LrTable.NT 0,(result,T_CHECK1left,tp2right),rest671)
  end
  | (1,(_,(MlyValue.T_ID (T_ID1 as T_ID),T_IDleft as T_ID1left,
  T_IDright as T_ID1right)) :: (_,(_,T_USEleft as T_USE1left,
  T_USEright as T_USE1right)) :: rest671) =>
  let val result = 
  MlyValue.start (((Use(T_ID))))
  in (LrTable.NT 0,(result,T_USE1left,T_ID1right),rest671)
  end
  | (2,(_,(MlyValue.tp (tp1 as tp),tpleft as tp1left,tpright as tp1right
  )) :: (_,(_,T_LEQleft as T_LEQ1left,T_LEQright as T_LEQ1right)) :: 
  (_,(MlyValue.id (id1 as id),idleft as id1left,idright as id1right
  )) :: (_,(_,T_TYPEleft as T_TYPE1left,T_TYPEright as T_TYPE1right
  )) :: rest671) =>
  let val result = 
  MlyValue.start (((Type_Assumption(id,tp))))
  in (LrTable.NT 0,(result,T_TYPE1left,tp1right),rest671)
  end
  | (3,(_,(MlyValue.tp (tp1 as tp),tpleft as tp1left,tpright as tp1right
  )) :: (_,(_,T_LEQleft as T_LEQ1left,T_LEQright as T_LEQ1right)) :: 
  (_,(MlyValue.id (id1 as id),idleft as id1left,idright as id1right
  )) :: rest671) =>
  let val result = 
  MlyValue.start (((Type_Assumption(id,tp))))
  in (LrTable.NT 0,(result,id1left,tp1right),rest671)
  end
  | (4,(_,(MlyValue.tp (tp1 as tp),tpleft as tp1left,tpright as tp1right
  )) :: (_,(_,T_DOUBLEEQleft as T_DOUBLEEQ1left,T_DOUBLEEQright as 
  T_DOUBLEEQ1right)) :: (_,(MlyValue.id (id1 as id),idleft as id1left,
  idright as id1right)) :: (_,(_,T_TYPEleft as T_TYPE1left,
  T_TYPEright as T_TYPE1right)) :: rest671) =>
  let val result = 
  MlyValue.start (((Type_Abbrev(id,tp))))
  in (LrTable.NT 0,(result,T_TYPE1left,tp1right),rest671)
  end
  | (5,(_,(MlyValue.tp (tp1 as tp),tpleft as tp1left,tpright as tp1right
  )) :: (_,(_,T_DOUBLEEQleft as T_DOUBLEEQ1left,T_DOUBLEEQright as 
  T_DOUBLEEQ1right)) :: (_,(MlyValue.id (id1 as id),idleft as id1left,
  idright as id1right)) :: rest671) =>
  let val result = 
  MlyValue.start (((Type_Abbrev(id,tp))))
  in (LrTable.NT 0,(result,id1left,tp1right),rest671)
  end
  | (6,(_,(MlyValue.term (term1 as term),termleft as term1left,
  termright as term1right)) :: (_,(_,T_EQleft as T_EQ1left,T_EQright as 
  T_EQ1right)) :: (_,(MlyValue.id (id1 as id),idleft as id1left,
  idright as id1right)) :: rest671) =>
  let val result = 
  MlyValue.start (((Term_Def(id,term))))
  in (LrTable.NT 0,(result,id1left,term1right),rest671)
  end
  | (7,(_,(MlyValue.term (term1 as term),termleft as term1left,
  termright as term1right)) :: rest671) =>
  let val result = 
  MlyValue.start (((Term_Def(Id.intern "it",term))))
  in (LrTable.NT 0,(result,term1left,term1right),rest671)
  end
  | (8,(_,(_,T_EOFleft as T_EOF1left,T_EOFright as T_EOF1right)) :: rest671) =>
  let val result = 
  MlyValue.start (((Nothing)))
  in (LrTable.NT 0,(result,T_EOF1left,T_EOF1right),rest671)
  end
  | (9,(_,(MlyValue.setcmd (setcmd1 as setcmd),setcmdleft as setcmd1left
  ,setcmdright as setcmd1right)) :: rest671) =>
  let val result = 
  MlyValue.start (((setcmd)))
  in (LrTable.NT 0,(result,setcmd1left,setcmd1right),rest671)
  end
  | (10,(_,(MlyValue.T_ID (T_ID1 as T_ID),T_IDleft as T_ID1left,
  T_IDright as T_ID1right)) :: (_,(_,T_SETleft as T_SET1left,
  T_SETright as T_SET1right)) :: rest671) =>
  let val result = 
  MlyValue.setcmd (((Set(T_ID,"true"))))
  in (LrTable.NT 1,(result,T_SET1left,T_ID1right),rest671)
  end
  | (11,(_,(MlyValue.T_ID (T_ID1 as T_ID),T_IDleft as T_ID1left,
  T_IDright as T_ID1right)) :: (_,(_,T_DEBUGleft as T_DEBUG1left,
  T_DEBUGright as T_DEBUG1right)) :: rest671) =>
  let val result = 
  MlyValue.setcmd (((Set(T_ID,"true"))))
  in (LrTable.NT 1,(result,T_DEBUG1left,T_ID1right),rest671)
  end
  | (12,(_,(MlyValue.T_ID (T_ID1 as T_ID),T_IDleft as T_ID1left,
  T_IDright as T_ID1right)) :: (_,(_,T_RESETleft as T_RESET1left,
  T_RESETright as T_RESET1right)) :: rest671) =>
  let val result = 
  MlyValue.setcmd (((Set(T_ID,"false"))))
  in (LrTable.NT 1,(result,T_RESET1left,T_ID1right),rest671)
  end
  | (13,(_,(MlyValue.id (id1 as id),idleft as id1left,idright as 
  id1right)) :: rest671) =>
  let val result = 
  MlyValue.tp (((PRETVAR(id))))
  in (LrTable.NT 5,(result,id1left,id1right),rest671)
  end
  | (14,(_,(MlyValue.tp (tp2),tp2left,tp2right)) :: (_,(_,
  T_ARROWleft as T_ARROW1left,T_ARROWright as T_ARROW1right)) :: (_,(
  MlyValue.tp (tp1 as tp),tpleft as tp1left,tpright as tp1right)) :: rest671) =>
  let val result = 
  MlyValue.tp (((PREARROW(tp1,tp2))))
  in (LrTable.NT 5,(result,tp1left,tp2right),rest671)
  end
  | (15,(_,(MlyValue.tp (tp2),tp2left,tp2right)) :: (_,(_,
  T_INTERleft as T_INTER1left,T_INTERright as T_INTER1right)) :: (_,(
  MlyValue.tp (tp1 as tp),tpleft as tp1left,tpright as tp1right)) :: rest671) =>
  let val result = 
  MlyValue.tp (((PREMEET([tp1,tp2]))))
  in (LrTable.NT 5,(result,tp1left,tp2right),rest671)
  end
  | (16,(_,(_,T_RBRACKleft as T_RBRACK1left,T_RBRACKright as 
  T_RBRACK1right)) :: (_,(MlyValue.tplist (tplist1 as tplist),
  tplistleft as tplist1left,tplistright as tplist1right)) :: (_,(_,
  T_LBRACKleft as T_LBRACK1left,T_LBRACKright as T_LBRACK1right)) :: 
  (_,(_,T_INTERleft as T_INTER1left,T_INTERright as T_INTER1right)) :: rest671) =>
  let val result = 
  MlyValue.tp (((PREMEET(tplist))))
  in (LrTable.NT 5,(result,T_INTER1left,T_RBRACK1right),rest671)
  end
  | (17,(_,(_,T_NSleft as T_NS1left,T_NSright as T_NS1right)) :: rest671) =>
  let val result = 
  MlyValue.tp (((PREMEET([]))))
  in (LrTable.NT 5,(result,T_NS1left,T_NS1right),rest671)
  end
  | (18,(_,(_,T_RPARENleft as T_RPAREN1left,T_RPARENright as 
  T_RPAREN1right)) :: (_,(MlyValue.tp (tp1 as tp),tpleft as tp1left,
  tpright as tp1right)) :: (_,(_,T_LPARENleft as T_LPAREN1left,
  T_LPARENright as T_LPAREN1right)) :: rest671) =>
  let val result = 
  MlyValue.tp (((tp)))
  in (LrTable.NT 5,(result,T_LPAREN1left,T_RPAREN1right),rest671)
  end
  | (19,(_,(MlyValue.tp (tp1 as tp),tpleft as tp1left,tpright as 
  tp1right)) :: (_,(_,T_DOTleft as T_DOT1left,T_DOTright as T_DOT1right
  )) :: (_,(MlyValue.id (id1 as id),idleft as id1left,idright as 
  id1right)) :: (_,(_,T_ALLleft as T_ALL1left,T_ALLright as T_ALL1right
  )) :: rest671) =>
  let val result = 
  MlyValue.tp (((PREALL(id, PREMEET[], tp))))
  in (LrTable.NT 5,(result,T_ALL1left,tp1right),rest671)
  end
  | (20,(_,(MlyValue.tp (tp2),tp2left,tp2right)) :: (_,(_,T_DOTleft as 
  T_DOT1left,T_DOTright as T_DOT1right)) :: (_,(MlyValue.tp (tp1 as tp),
  tpleft as tp1left,tpright as tp1right)) :: (_,(_,T_LEQleft as 
  T_LEQ1left,T_LEQright as T_LEQ1right)) :: (_,(MlyValue.id (id1 as id),
  idleft as id1left,idright as id1right)) :: (_,(_,T_ALLleft as 
  T_ALL1left,T_ALLright as T_ALL1right)) :: rest671) =>
  let val result = 
  MlyValue.tp (((PREALL(id, tp1, tp2))))
  in (LrTable.NT 5,(result,T_ALL1left,tp2right),rest671)
  end
  | (21,(_,(MlyValue.tp (tp1 as tp),tpleft as tp1left,tpright as 
  tp1right)) :: (_,(_,T_DOTleft as T_DOT1left,T_DOTright as T_DOT1right
  )) :: (_,(MlyValue.id (id1 as id),idleft as id1left,idright as 
  id1right)) :: (_,(_,T_SOMEleft as T_SOME1left,T_SOMEright as 
  T_SOME1right)) :: rest671) =>
  let val result = 
  MlyValue.tp (((
  let val b = Id.new()
		       val bv = PRETVAR(b)
		       val idv = PRETVAR(id)
		   in PREALL(b,PREMEET[], 
			     PREARROW(PREALL(id, PREMEET[], 
					  PREARROW(tp, bv)),
				   bv))
		   end
  )))
  in (LrTable.NT 5,(result,T_SOME1left,tp1right),rest671)
  end
  | (22,(_,(MlyValue.tp (tp2),tp2left,tp2right)) :: (_,(_,T_DOTleft as 
  T_DOT1left,T_DOTright as T_DOT1right)) :: (_,(MlyValue.tp (tp1 as tp),
  tpleft as tp1left,tpright as tp1right)) :: (_,(_,T_LEQleft as 
  T_LEQ1left,T_LEQright as T_LEQ1right)) :: (_,(MlyValue.id (id1 as id),
  idleft as id1left,idright as id1right)) :: (_,(_,T_SOMEleft as 
  T_SOME1left,T_SOMEright as T_SOME1right)) :: rest671) =>
  let val result = 
  MlyValue.tp (((
  let val b = Id.new()
		       val bv = PRETVAR(b)
		       val idv = PRETVAR(id)
		   in PREALL(b,PREMEET[], 
			     PREARROW(PREALL(id, tp1, 
					  PREARROW(tp2, bv)),
				   bv))
		   end
  )))
  in (LrTable.NT 5,(result,T_SOME1left,tp2right),rest671)
  end
  | (23,(_,(MlyValue.tp (tp1 as tp),tpleft as tp1left,tpright as 
  tp1right)) :: rest671) =>
  let val result = 
  MlyValue.tplist ((([tp])))
  in (LrTable.NT 6,(result,tp1left,tp1right),rest671)
  end
  | (24,(_,(MlyValue.tplist (tplist1 as tplist),tplistleft as 
  tplist1left,tplistright as tplist1right)) :: (_,(_,T_COMMAleft as 
  T_COMMA1left,T_COMMAright as T_COMMA1right)) :: (_,(MlyValue.tp (tp1
   as tp),tpleft as tp1left,tpright as tp1right)) :: rest671) =>
  let val result = 
  MlyValue.tplist (((tp::tplist)))
  in (LrTable.NT 6,(result,tp1left,tplist1right),rest671)
  end
  | (25,(_,(MlyValue.id (id1 as id),idleft as id1left,idright as 
  id1right)) :: rest671) =>
  let val result = 
  MlyValue.idlist ((([id])))
  in (LrTable.NT 3,(result,id1left,id1right),rest671)
  end
  | (26,(_,(MlyValue.idlist (idlist1 as idlist),idlistleft as 
  idlist1left,idlistright as idlist1right)) :: (_,(_,T_COMMAleft as 
  T_COMMA1left,T_COMMAright as T_COMMA1right)) :: (_,(MlyValue.id (id1
   as id),idleft as id1left,idright as id1right)) :: rest671) =>
  let val result = 
  MlyValue.idlist (((id::idlist)))
  in (LrTable.NT 3,(result,id1left,idlist1right),rest671)
  end
  | (27,(_,(MlyValue.T_ID (T_ID1 as T_ID),T_IDleft as T_ID1left,
  T_IDright as T_ID1right)) :: rest671) =>
  let val result = 
  MlyValue.id (((Id.intern T_ID)))
  in (LrTable.NT 2,(result,T_ID1left,T_ID1right),rest671)
  end
  | (28,(_,(MlyValue.id (id1 as id),idleft as id1left,idright as 
  id1right)) :: rest671) =>
  let val result = 
  MlyValue.const (((id)))
  in (LrTable.NT 4,(result,id1left,id1right),rest671)
  end
  | (29,(_,(MlyValue.T_INT_CONST (T_INT_CONST1 as T_INT_CONST),
  T_INT_CONSTleft as T_INT_CONST1left,T_INT_CONSTright as 
  T_INT_CONST1right)) :: rest671) =>
  let val result = 
  MlyValue.const (((Id.intern T_INT_CONST)))
  in (LrTable.NT 4,(result,T_INT_CONST1left,T_INT_CONST1right),rest671)
  end
  | (30,(_,(MlyValue.T_STR_CONST (T_STR_CONST1 as T_STR_CONST),
  T_STR_CONSTleft as T_STR_CONST1left,T_STR_CONSTright as 
  T_STR_CONST1right)) :: rest671) =>
  let val result = 
  MlyValue.const (((Id.intern T_STR_CONST)))
  in (LrTable.NT 4,(result,T_STR_CONST1left,T_STR_CONST1right),rest671)
  end
  | (31,(_,(MlyValue.appl (appl1 as appl),applleft as appl1left,
  applright as appl1right)) :: rest671) =>
  let val result = 
  MlyValue.term (((appl)))
  in (LrTable.NT 7,(result,appl1left,appl1right),rest671)
  end
  | (32,(_,(MlyValue.bnd (bnd1 as bnd),bndleft as bnd1left,bndright as 
  bnd1right)) :: rest671) =>
  let val result = 
  MlyValue.term (((bnd)))
  in (LrTable.NT 7,(result,bnd1left,bnd1right),rest671)
  end
  | (33,(_,(MlyValue.term (term1 as term),termleft as term1left,
  termright as term1right)) :: (_,(_,T_DOTleft as T_DOT1left,
  T_DOTright as T_DOT1right)) :: (_,(MlyValue.tplist (tplist1 as tplist)
  ,tplistleft as tplist1left,tplistright as tplist1right)) :: (_,(_,
  T_COLONleft as T_COLON1left,T_COLONright as T_COLON1right)) :: (_,(
  MlyValue.id (id1 as id),idleft as id1left,idright as id1right)) :: 
  (_,(_,T_LAMBDAleft as T_LAMBDA1left,T_LAMBDAright as T_LAMBDA1right
  )) :: rest671) =>
  let val result = 
  MlyValue.bnd (((
  case tplist of 
					      [t] => PREABS(id,t,term)
					    | ts  => 
						let val a = Id.new_from id
						in PREFOR(a,ts,
						     PREABS(id,PRETVAR(a),term))
						end
  )))
  in (LrTable.NT 9,(result,T_LAMBDA1left,term1right),rest671)
  end
  | (34,(_,(MlyValue.term (term1 as term),termleft as term1left,
  termright as term1right)) :: (_,(_,T_DOTleft as T_DOT1left,
  T_DOTright as T_DOT1right)) :: (_,(MlyValue.id (id1 as id),idleft as 
  id1left,idright as id1right)) :: (_,(_,T_BIGLAMBDAleft as 
  T_BIGLAMBDA1left,T_BIGLAMBDAright as T_BIGLAMBDA1right)) :: rest671) =>
  let val result = 
  MlyValue.bnd (((PRETABS(id,PREMEET[],term))))
  in (LrTable.NT 9,(result,T_BIGLAMBDA1left,term1right),rest671)
  end
  | (35,(_,(MlyValue.term (term1 as term),termleft as term1left,
  termright as term1right)) :: (_,(_,T_DOTleft as T_DOT1left,
  T_DOTright as T_DOT1right)) :: (_,(MlyValue.tp (tp1 as tp),tpleft as 
  tp1left,tpright as tp1right)) :: (_,(_,T_LEQleft as T_LEQ1left,
  T_LEQright as T_LEQ1right)) :: (_,(MlyValue.id (id1 as id),idleft as 
  id1left,idright as id1right)) :: (_,(_,T_BIGLAMBDAleft as 
  T_BIGLAMBDA1left,T_BIGLAMBDAright as T_BIGLAMBDA1right)) :: rest671) =>
  let val result = 
  MlyValue.bnd (((PRETABS(id,tp,term))))
  in (LrTable.NT 9,(result,T_BIGLAMBDA1left,term1right),rest671)
  end
  | (36,(_,(MlyValue.term (term1 as term),termleft as term1left,
  termright as term1right)) :: (_,(_,T_DOTleft as T_DOT1left,
  T_DOTright as T_DOT1right)) :: (_,(MlyValue.tplist (tplist1 as tplist)
  ,tplistleft as tplist1left,tplistright as tplist1right)) :: (_,(_,
  T_INleft as T_IN1left,T_INright as T_IN1right)) :: (_,(MlyValue.idlist
   (idlist1 as idlist),idlistleft as idlist1left,idlistright as 
  idlist1right)) :: (_,(_,T_BIGLAMBDAleft as T_BIGLAMBDA1left,
  T_BIGLAMBDAright as T_BIGLAMBDA1right)) :: rest671) =>
  let val result = 
  MlyValue.bnd (((
  let fun f [] = term
						 | f (v::vs) =
						      PREFOR(v, tplist, f vs)
					   in f idlist end
  )))
  in (LrTable.NT 9,(result,T_BIGLAMBDA1left,term1right),rest671)
  end
  | (37,(_,(MlyValue.term (term1 as term),termleft as term1left,
  termright as term1right)) :: (_,(_,T_DOTleft as T_DOT1left,
  T_DOTright as T_DOT1right)) :: (_,(MlyValue.tplist (tplist1 as tplist)
  ,tplistleft as tplist1left,tplistright as tplist1right)) :: (_,(_,
  T_INleft as T_IN1left,T_INright as T_IN1right)) :: (_,(MlyValue.idlist
   (idlist1 as idlist),idlistleft as idlist1left,idlistright as 
  idlist1right)) :: (_,(_,T_FORleft as T_FOR1left,T_FORright as 
  T_FOR1right)) :: rest671) =>
  let val result = 
  MlyValue.bnd (((
  let fun f [] = term
						 | f (v::vs) =
						      PREFOR(v, tplist, f vs)
					   in f idlist end
  )))
  in (LrTable.NT 9,(result,T_FOR1left,term1right),rest671)
  end
  | (38,(_,(MlyValue.const (const1 as const),constleft as const1left,
  constright as const1right)) :: rest671) =>
  let val result = 
  MlyValue.appl (((PREVAR(const))))
  in (LrTable.NT 8,(result,const1left,const1right),rest671)
  end
  | (39,(_,(_,T_RPARENleft as T_RPAREN1left,T_RPARENright as 
  T_RPAREN1right)) :: (_,(MlyValue.term (term1 as term),termleft as 
  term1left,termright as term1right)) :: (_,(_,T_LPARENleft as 
  T_LPAREN1left,T_LPARENright as T_LPAREN1right)) :: rest671) =>
  let val result = 
  MlyValue.appl (((term)))
  in (LrTable.NT 8,(result,T_LPAREN1left,T_RPAREN1right),rest671)
  end
  | (40,(_,(MlyValue.id (id1 as id),idleft as id1left,idright as 
  id1right)) :: (_,(MlyValue.appl (appl1 as appl),applleft as appl1left,
  applright as appl1right)) :: rest671) =>
  let val result = 
  MlyValue.appl (((PREAPP(appl,PREVAR(id)))))
  in (LrTable.NT 8,(result,appl1left,id1right),rest671)
  end
  | (41,(_,(_,T_RPARENleft as T_RPAREN1left,T_RPARENright as 
  T_RPAREN1right)) :: (_,(MlyValue.term (term1 as term),termleft as 
  term1left,termright as term1right)) :: (_,(_,T_LPARENleft as 
  T_LPAREN1left,T_LPARENright as T_LPAREN1right)) :: (_,(MlyValue.appl (
  appl1 as appl),applleft as appl1left,applright as appl1right)) :: rest671) =>
  let val result = 
  MlyValue.appl (((PREAPP(appl,term))))
  in (LrTable.NT 8,(result,appl1left,T_RPAREN1right),rest671)
  end
  | (42,(_,(_,T_RBRACKleft as T_RBRACK1left,T_RBRACKright as 
  T_RBRACK1right)) :: (_,(MlyValue.tp (tp1 as tp),tpleft as tp1left,
  tpright as tp1right)) :: (_,(_,T_LBRACKleft as T_LBRACK1left,
  T_LBRACKright as T_LBRACK1right)) :: (_,(MlyValue.appl (appl1 as appl)
  ,applleft as appl1left,applright as appl1right)) :: rest671) =>
  let val result = 
  MlyValue.appl (((PRETAPP(appl,tp))))
  in (LrTable.NT 8,(result,appl1left,T_RBRACK1right),rest671)
  end
  | _ => raise (mlyAction i392)
  end
  val void = MlyValue.VOID
  val extract = fn a => (fn MlyValue.start x => x
  | _ => let exception ParseInternal
	  in raise ParseInternal end) a 
  end
  end
  structure Tokens : FMEET_TOKENS =
  struct
  type svalue = ParserData.svalue
  type ('a,'b) token = ('a,'b) Token.token
  fun T_EOF (p1,p2) = Token.TOKEN (ParserData.LrTable.T 0,(
  ParserData.MlyValue.VOID,p1,p2))
  fun T_DOT (p1,p2) = Token.TOKEN (ParserData.LrTable.T 1,(
  ParserData.MlyValue.VOID,p1,p2))
  fun T_COLON (p1,p2) = Token.TOKEN (ParserData.LrTable.T 2,(
  ParserData.MlyValue.VOID,p1,p2))
  fun T_SEMICOLON (p1,p2) = Token.TOKEN (ParserData.LrTable.T 3,(
  ParserData.MlyValue.VOID,p1,p2))
  fun T_LEQ (p1,p2) = Token.TOKEN (ParserData.LrTable.T 4,(
  ParserData.MlyValue.VOID,p1,p2))
  fun T_COMMA (p1,p2) = Token.TOKEN (ParserData.LrTable.T 5,(
  ParserData.MlyValue.VOID,p1,p2))
  fun T_APOST (p1,p2) = Token.TOKEN (ParserData.LrTable.T 6,(
  ParserData.MlyValue.VOID,p1,p2))
  fun T_EQ (p1,p2) = Token.TOKEN (ParserData.LrTable.T 7,(
  ParserData.MlyValue.VOID,p1,p2))
  fun T_DOUBLEEQ (p1,p2) = Token.TOKEN (ParserData.LrTable.T 8,(
  ParserData.MlyValue.VOID,p1,p2))
  fun T_DOLLAR (p1,p2) = Token.TOKEN (ParserData.LrTable.T 9,(
  ParserData.MlyValue.VOID,p1,p2))
  fun T_AT (p1,p2) = Token.TOKEN (ParserData.LrTable.T 10,(
  ParserData.MlyValue.VOID,p1,p2))
  fun T_ARROW (p1,p2) = Token.TOKEN (ParserData.LrTable.T 11,(
  ParserData.MlyValue.VOID,p1,p2))
  fun T_DARROW (p1,p2) = Token.TOKEN (ParserData.LrTable.T 12,(
  ParserData.MlyValue.VOID,p1,p2))
  fun T_LPAREN (p1,p2) = Token.TOKEN (ParserData.LrTable.T 13,(
  ParserData.MlyValue.VOID,p1,p2))
  fun T_RPAREN (p1,p2) = Token.TOKEN (ParserData.LrTable.T 14,(
  ParserData.MlyValue.VOID,p1,p2))
  fun T_LBRACK (p1,p2) = Token.TOKEN (ParserData.LrTable.T 15,(
  ParserData.MlyValue.VOID,p1,p2))
  fun T_RBRACK (p1,p2) = Token.TOKEN (ParserData.LrTable.T 16,(
  ParserData.MlyValue.VOID,p1,p2))
  fun T_LANGLE (p1,p2) = Token.TOKEN (ParserData.LrTable.T 17,(
  ParserData.MlyValue.VOID,p1,p2))
  fun T_RANGLE (p1,p2) = Token.TOKEN (ParserData.LrTable.T 18,(
  ParserData.MlyValue.VOID,p1,p2))
  fun T_LCURLY (p1,p2) = Token.TOKEN (ParserData.LrTable.T 19,(
  ParserData.MlyValue.VOID,p1,p2))
  fun T_RCURLY (p1,p2) = Token.TOKEN (ParserData.LrTable.T 20,(
  ParserData.MlyValue.VOID,p1,p2))
  fun T_INTER (p1,p2) = Token.TOKEN (ParserData.LrTable.T 21,(
  ParserData.MlyValue.VOID,p1,p2))
  fun T_LAMBDA (p1,p2) = Token.TOKEN (ParserData.LrTable.T 22,(
  ParserData.MlyValue.VOID,p1,p2))
  fun T_BIGLAMBDA (p1,p2) = Token.TOKEN (ParserData.LrTable.T 23,(
  ParserData.MlyValue.VOID,p1,p2))
  fun T_ID (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 24,(
  ParserData.MlyValue.T_ID i,p1,p2))
  fun T_INT_CONST (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 25,(
  ParserData.MlyValue.T_INT_CONST i,p1,p2))
  fun T_STR_CONST (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 26,(
  ParserData.MlyValue.T_STR_CONST i,p1,p2))
  fun T_USE (p1,p2) = Token.TOKEN (ParserData.LrTable.T 27,(
  ParserData.MlyValue.VOID,p1,p2))
  fun T_TYPE (p1,p2) = Token.TOKEN (ParserData.LrTable.T 28,(
  ParserData.MlyValue.VOID,p1,p2))
  fun T_SET (p1,p2) = Token.TOKEN (ParserData.LrTable.T 29,(
  ParserData.MlyValue.VOID,p1,p2))
  fun T_RESET (p1,p2) = Token.TOKEN (ParserData.LrTable.T 30,(
  ParserData.MlyValue.VOID,p1,p2))
  fun T_DEBUG (p1,p2) = Token.TOKEN (ParserData.LrTable.T 31,(
  ParserData.MlyValue.VOID,p1,p2))
  fun T_CHECK (p1,p2) = Token.TOKEN (ParserData.LrTable.T 32,(
  ParserData.MlyValue.VOID,p1,p2))
  fun T_WITH (p1,p2) = Token.TOKEN (ParserData.LrTable.T 33,(
  ParserData.MlyValue.VOID,p1,p2))
  fun T_ALL (p1,p2) = Token.TOKEN (ParserData.LrTable.T 34,(
  ParserData.MlyValue.VOID,p1,p2))
  fun T_IN (p1,p2) = Token.TOKEN (ParserData.LrTable.T 35,(
  ParserData.MlyValue.VOID,p1,p2))
  fun T_NS (p1,p2) = Token.TOKEN (ParserData.LrTable.T 36,(
  ParserData.MlyValue.VOID,p1,p2))
  fun T_CASE (p1,p2) = Token.TOKEN (ParserData.LrTable.T 37,(
  ParserData.MlyValue.VOID,p1,p2))
  fun T_OF (p1,p2) = Token.TOKEN (ParserData.LrTable.T 38,(
  ParserData.MlyValue.VOID,p1,p2))
  fun T_FOR (p1,p2) = Token.TOKEN (ParserData.LrTable.T 39,(
  ParserData.MlyValue.VOID,p1,p2))
  fun T_OBSERVE (p1,p2) = Token.TOKEN (ParserData.LrTable.T 40,(
  ParserData.MlyValue.VOID,p1,p2))
  fun T_INSTALL (p1,p2) = Token.TOKEN (ParserData.LrTable.T 41,(
  ParserData.MlyValue.VOID,p1,p2))
  fun T_SOME (p1,p2) = Token.TOKEN (ParserData.LrTable.T 42,(
  ParserData.MlyValue.VOID,p1,p2))
  fun T_OPEN (p1,p2) = Token.TOKEN (ParserData.LrTable.T 43,(
  ParserData.MlyValue.VOID,p1,p2))
  fun T_END (p1,p2) = Token.TOKEN (ParserData.LrTable.T 44,(
  ParserData.MlyValue.VOID,p1,p2))
  fun T_PACK (p1,p2) = Token.TOKEN (ParserData.LrTable.T 45,(
  ParserData.MlyValue.VOID,p1,p2))
  end
  end
  signature FILEUTILS = sig

  val open_fmeet_file: string -> (instream * string)

  end
  functor Main(
	   structure Globals: GLOBALS
	   structure Typ: TYP
	   structure Trm: TRM
	   structure FileUtils: FILEUTILS
	   structure Parse: PARSE
	   structure Leq: LEQ
	   structure Synth: SYNTH
	   sharing Typ.Globals = Globals
	       and Parse.ParseRes.Typ = Typ
	       and Parse.ParseRes.Trm = Trm
	       and Leq.Typ = Typ
	       and Trm.Typ = Typ
	       and Synth.Trm = Trm
	       and Synth.Leq = Leq
	   val buildtime : string
	  ) = struct

  open Globals;
  open Parse.ParseRes;

  val global_tenv = ref(Typ.empty_tenv)

  exception NotABoolean

  fun string_to_bool "true" = true
    | string_to_bool "True" = true
    | string_to_bool "TRUE" = true
    | string_to_bool "t" = true
    | string_to_bool "T" = true
    | string_to_bool "yes" = true
    | string_to_bool "Yes" = true
    | string_to_bool "YES" = true
    | string_to_bool "false" = false
    | string_to_bool "False" = false
    | string_to_bool "FALSE" = false
    | string_to_bool "f" = false
    | string_to_bool "F" = false
    | string_to_bool "no" = false
    | string_to_bool "No" = false
    | string_to_bool "NO" = false
    | string_to_bool _ = raise NotABoolean

  fun rep_loop done parser error =
    while (not (done())) do
      (case parser() of
	   Use(f) => 
	     rep_loop_on_file f
	 | Type_Assumption(i,pt) =>
	     let val t = Typ.debruijnify (!global_tenv) pt
	     in 
		write (Id.tostr i);
		write " <= ";
		Typ.prt (stdpp()) (!global_tenv) t;
		write "\n";
		global_tenv := Typ.push_bound (!global_tenv) i t
	     end
	 | Type_Abbrev(i,pt) =>
	     let val t = Typ.debruijnify (!global_tenv) pt
		 val _ = global_tenv := Typ.push_abbrev (!global_tenv) i t
	     in 
		write (Id.tostr i);
		write " == ";
		Typ.prt (stdpp()) (!global_tenv) t;
		write "\n"
	     end
	 | Term_Def(i,ptrm) =>
	     let val trm = Trm.debruijnify (!global_tenv) ptrm
		 val typ = Synth.synth (!global_tenv) trm
	     in 
		write (Id.tostr i);
		write " = ";
		Pp.setb (stdpp());
		Trm.prt (stdpp()) (!global_tenv) trm;
		Pp.break (stdpp()) true ~3;
		write " : ";
		Typ.prt (stdpp()) (!global_tenv) typ;
		Pp.break (stdpp()) true ~3;
		(* write " in ";
		   Typ.prt_tenv (stdpp()) (Typ.pop (!global_tenv)); *)
		Pp.endb (stdpp());
		write "\n";
		global_tenv := Typ.push_binding (!global_tenv) i typ
	     end
	 | Leq(pt1,pt2) =>
	     let val t1 = Typ.debruijnify (!global_tenv) pt1
		 val t2 = Typ.debruijnify (!global_tenv) pt2
	     in 
		if Leq.leq (!global_tenv) t1 t2 
		  then write "Yes\n"
		  else write "No\n"
		end
	 | Nothing => 
	     ()
	 | Set(name,v) => 
	     (set_flag name (string_to_bool v))
	 | _ => 
	   write "Unimplemented ParseResult!\n"
      )
      handle 
	Typ.WrongKindOfId(te,i,which) => 
	    (write ("Wrong kind of identifier: "^ (makestring i) ^" ("
		    ^ which ^ " expected)\nin "); 
	     Typ.prt_tenv (stdpp()) te;
	     error())
      | unknown => 
	    (write ("Exception: "^(System.exn_name unknown)^"\n"); 
	     error())

  and rep_loop_on_file fname =
	   let val (dev,real_name) = FileUtils.open_fmeet_file fname
	       val quit = ref false
	       fun parser() = Parse.stream_parse dev
	       fun done() = (!quit) orelse (end_of_stream dev)
	       fun error() = (quit := true);
	   in 
	      write ("Reading from \"" ^ real_name ^ "\"...\n\n");
	      (rep_loop done parser error;
	       write ("\nClosing " ^ real_name ^ "\n");
	       close_in dev)
	      handle Io(s) => write ("IO error on " ^ fname ^ ": " ^ s ^ "\n")
	   end

  fun top() = 
    let fun top_done () = (print "> "; flush_out std_out; end_of_stream(std_in))
	fun top_error () = ()
    in
      write ("Welcome to FMEET (" ^ buildtime ^ ")...\n\n");
      rep_loop top_done Parse.top_parse top_error;
      write "\n"
    end

  val read_from_file = ref "";

  fun parse_switches ("-i"::s::rest) 
	  = (read_from_file := s;
	     parse_switches rest)
    | parse_switches (s::rest) 
	  = (read_from_file := s;
	     parse_switches rest)
    | parse_switches ([]) 
	  = ()

  fun rep_command_line(argv,env) = 
    (parse_switches (tl argv);
     if (!read_from_file) = ""
	then top()
	else rep_loop_on_file (!read_from_file)
     )

  fun process_file s = rep_command_line (["",s^".fm"],nil);

  end


  functor WrMgt(
	      structure Wr: WR
	      structure Pp: PP
	      sharing Pp.Wr = Wr
	      ) : WRMGT 
	      = struct

  structure Wr = Wr;
  structure Pp = Pp;

  val current_underlying_wr = ref(Wr.to_stdout());
  val current_pp = ref(Pp.pp_from_wr (!current_underlying_wr));
  val current_wr = ref(Pp.wr_from_pp (!current_pp));

  fun stdpp() = !current_pp;

  fun get_current_wr() = !current_wr;

  fun set_current_wr wr =
    (current_underlying_wr := wr;
     current_pp := Pp.pp_from_wr (!current_underlying_wr);
     current_wr := Pp.wr_from_pp (!current_pp))

  fun write s = Pp.pwrite (!current_pp) s;

  end
  functor Id (structure SymTab: HASH
	      structure InvSymTab: TABLE
	      sharing type SymTab.elem = string
		  and type InvSymTab.key = int
	     ) : ID =
  struct

  val symtab = ref SymTab.empty;
  val invsymtab = ref (InvSymTab.empty: string InvSymTab.table);

  val DEBUG = ref false;

  type T = int

  exception CantHappen

  fun intern (s:string) = 
	let val _ = if not (SymTab.exists(s,!symtab))
			   then symtab := SymTab.add(s, (!symtab))
			   else ()
	    val i_opt = SymTab.find (s, (!symtab))
	in
	   case i_opt of
	     NONE => raise CantHappen
	   | SOME(i) => 
	       (invsymtab := InvSymTab.insert((i,s), (!invsymtab));
		i)
	end

  fun hashcode i = i

  exception UnknownId

  fun tostr (i:T) : string = 
	  let val s_opt = InvSymTab.find (i, (!invsymtab))
	  in
	      case s_opt of
		 NONE => raise UnknownId
	       | SOME(s) => s
	  end

  val newvarcount = ref 0;

  fun reset_new_counter() = (newvarcount := 0)

  fun new_from i =
      let val _ = newvarcount := !newvarcount + 1
	  val name = (tostr i) ^ "_" ^ (makestring (!newvarcount))
      in 
	 if SymTab.exists(name,!symtab)
	    then new_from i
	    else intern name
      end

  val id_x = intern "x"

  fun new() = new_from id_x

  fun == (i:T) (i':T) = (i = i')

  fun lexlt (i:T) (i':T) = ((tostr i) < (tostr i'))

  end
  functor FileUtils(): FILEUTILS = struct

  fun open_fmeet_file fname =
	  (open_in fname,fname)
	  handle Io(s) => 
	  (open_in (fname ^ ".fm"), fname ^ ".fm")
	  handle Io(s) => 
	  (open_in ("examples/" ^ fname), "examples/" ^ fname)
	  handle Io(s) => 
	  (open_in ("examples/" ^ fname ^ ".fm"), "examples/" ^ fname ^ ".fm")
	  handle Io(s) => raise Io(fname ^ " not found")

  end
  functor ParseRes 
	      (structure Typ: TYP
	       structure Trm: TRM
	       structure Globals: GLOBALS
	       sharing Typ.Globals = Globals
		   and Trm.Typ = Typ
	      ) : PARSERES 
	      = struct

  structure Typ = Typ
  structure Trm = Trm
  structure Globals = Globals

  datatype T =
      Leq of Typ.pretyp * Typ.pretyp
    | Type_Assumption of Globals.Id.T * Typ.pretyp
    | Type_Abbrev of Globals.Id.T * Typ.pretyp
    | Term_Def of Globals.Id.T * Trm.pretrm
    | Term_Assumption of Globals.Id.T * Typ.pretyp
    | Use of string
    | Set of string * string
    | Nothing

  end 
  (* ----------------------------------------------------------------------- *)
  (*									   *)
  (* Low-level prettyprinting stream package.  Based on notes by Greg Nelson *)
  (*									   *)
  (* ----------------------------------------------------------------------- *)

  functor Pp (structure Wr: WR) : PP =
  struct

  structure Wr = Wr

  (* ----------------------------------------------------------------------- *)
  (*				 Utilities				   *)
  (* ----------------------------------------------------------------------- *)

  val DEBUG = ref false;

  fun debug ss = if (!DEBUG) 
		     then print ((implode ss) ^ "\n")
		     else ()

  fun mapunit f = 
      let fun m ([]) = ()
	    | m (hd::tl) = ((f hd); m tl)
      in m
      end

  (* ----------------------------------------------------------------------- *)
  (*			      Data Structures				   *)
  (* ----------------------------------------------------------------------- *)

  datatype BreakBehavior =
	  NLINDENT of int
	| EXPLICIT of string

  datatype Token = 
	  CHAR of int
	| SETB
	| ENDB
	| BREAK of {united:bool, do_what:BreakBehavior}
	| LONG of string

  datatype RefList =
	  NIL 
	| CONS of Token * (RefList ref)

  exception CalledErrorCont
  val error_cont : unit cont = 
      callcc (fn k => (callcc (fn ek => throw k ek); raise CalledErrorCont))

  exception CoroutineBug
  exception PPQueueOverflowed

  type Pp = {wr:Wr.Wr, 
	    q: Token array,
	    qr: int ref, 
	    inp: int ref, 
	    m1: int ref,
	    m2: int ref,
	    m3: int ref,
	    outq: Token array,
	    outp: int ref,
	    indent: int ref,
	    margin: int ref,
	    empty: unit cont ref,
	    nonempty: unit cont ref}

  val qlen = 500;
  val outqlen = 500;
  val default_margin = 76;

  fun init_pp (wr:Wr.Wr) : Pp = 
      {wr = wr,
       q = array(qlen, CHAR(33)),
       qr = ref 0,
       inp = ref 0,
       m1 = ref 0,
       m2 = ref 0,
       m3 = ref 0,
       outq = array(outqlen, CHAR(33)),
       outp = ref 0,
       indent = ref 0,
       margin = ref default_margin,
       empty = ref(error_cont), 
       nonempty = ref(error_cont)}

  fun enqueue (pp:Pp) tok =
      let val {q=q, qr=qr, inp=inp, m1=m1, empty=empty, nonempty=nonempty, ...} 
	      = pp
	  val curqr = !qr
	  val _ = debug ["enqueue: "," qr=",makestring (!qr),
				     " inp=",makestring (!inp),
				     " m1=",makestring (!m1)]
      in
	 debug ["enqueue"];
	 if ((curqr+1) mod qlen = (!inp)) orelse ((curqr+1) mod qlen = (!m1)) 
	    then raise PPQueueOverflowed
	    else ();
	 update(q, curqr, tok);
	 qr := (curqr + 1) mod qlen;
	 debug ["enqueue: about to switch"];
	 callcc (fn k => (empty := k; throw (!nonempty) ()));
	 debug ["enqueue: returning"]
      end

  fun requeue (pp:Pp) =
      let val {q=q, qr=qr, inp=inp, empty=empty, nonempty=nonempty, m1=m1, ...} 
	      = pp
	  val _ = debug ["requeue: "," qr=",makestring (!qr),
				     " inp=",makestring (!inp),
				     " m1=",makestring (!m1)]
      in 
	 inp := ((!inp) - 1) mod qlen
      end

  fun dequeue (pp:Pp) =
      let val {q=q, qr=qr, inp=inp, empty=empty, nonempty=nonempty, m1=m1, ...} 
	      = pp
	  val _ = debug ["dequeue: "," qr=",makestring (!qr),
				     " inp=",makestring (!inp),
				     " m1=",makestring (!m1)]
	  val _ = (* Front make sure there's something to dequeue *)
		  callcc (fn k => 
			  (debug ["dequeue: checking for input"];
			   if (!inp) = (!qr) 
			       then (debug ["dequeue: blocking"];
				     nonempty := k; 
				     throw (!empty) ())
			   else ()))
	  val _ = debug ["dequeue: unblocked"]
	  val _ = if (!inp)<0 orelse (!inp)>qlen 
		     then print ("About to crash: "^(makestring (!inp))^"\n")
		     else ()
	  val c = q sub (!inp)
	  val _ = inp := ((!inp) + 1) mod qlen
      in 
	 debug ["dequeue: returning"];
	 c
      end

  (* ----------------------------------------------------------------------- *)
  (*				Processing				   *)
  (* ----------------------------------------------------------------------- *)

  exception LineTooLong
  exception HowdThatGetInHere

  fun raw_printline (pp as {wr=wr, outq=outq, outp=outp, ...}:Pp) =
	let val i = ref 0
	in 
	   while ((!i)<(!outp)) do
	     (case outq sub (!i) of
		  CHAR(c) => Wr.write_wr wr (chr c)
		| LONG(s) => Wr.write_wr wr s
		| _ => raise HowdThatGetInHere;
	      i := (!i)+1)
	end 

  fun write_tok (pp as {outq=outq, outp=outp, 
			indent=indent, margin=margin, ...}:Pp) 
		c raiseok =
      let in
	  update (outq,!outp,c);
	  if (!outp) < outqlen 
	     then outp := (!outp)+1
	     else ();
	  case c of
	      CHAR(10) => (raw_printline pp;
			   indent := 0;
			   outp := 0)
	    | _        => (indent := (!indent)+1;
					if (!indent) > (!margin)
					   andalso raiseok
					  then raise LineTooLong 
					  else ())
      end

  fun do_break pp indent (NLINDENT(n)) =
      let val i = ref 0
      in
	write_tok pp (CHAR(10)) true;
	while ((!i)<n+indent) do
	  (write_tok pp (CHAR(32)) true;
	   i := (!i)+1)
      end
    | do_break pp indent (EXPLICIT(s)) =
      mapunit (fn s => enqueue pp (CHAR(ord s))) (explode s)

  fun P1 pp = 
      let fun loop() = 
	       (debug ["P1_loop"];
		case dequeue pp of
		    (c as CHAR(_)) => (write_tok pp c true; loop())
		  | (c as LONG(_)) => (write_tok pp c true; loop())
		  | SETB => (P1 pp; loop())
		  | BREAK(_) => loop()
		  | ENDB => ())
      in debug ["P1"];
	 loop();
	 debug ["P1: finished"]
      end

  and P2 pp = 
      let fun loop() = 
	       (debug ["P2_loop"];
		case dequeue pp of
		    (c as CHAR(_)) => (write_tok pp c true; loop())
		  | (c as LONG(_)) => (write_tok pp c true; loop())
		  | SETB => (P1 pp; loop())
		  | BREAK(_) => ()
		  | ENDB => ())
      in debug ["P2"];
	 loop();
	 (* I think the input queue needs to be backed up by one now, so that
	    P3 sees this SETB or BREAK... *)
	 requeue pp;
	 debug ["P2: finished"]
      end

  and P3 (pp as {inp=inp, outp=outp, indent=indent, 
		 m1=m1, m2=m2, m3=m3, ...} :Pp) = 
      let val saved_indent = !indent
	  fun loop() = 
	       (debug ["P3_loop"];
		case dequeue pp of
		    (c as CHAR(_)) => (write_tok pp c false; loop())
		  | (c as LONG(_)) => (write_tok pp c false; loop())
		  | SETB => (PP pp; loop())
		  | BREAK({united=true,do_what=do_what}) => 
			(do_break pp saved_indent do_what;
			 m1 := ~1; (* Not in CGN's original note *)
			 loop())
		  | BREAK({united=false,do_what=do_what}) => 
			(m1 := (!inp); m2 := (!outp); m3 := (!indent);
			 ((P2 pp; 
			   m1 := ~1; (* This once seemed wrong *)
			   debug ["P3: looping back"]; 
			   loop())
			  handle LineTooLong =>
			     (debug ["P3: line too long"];
			      inp := (!m1); outp := (!m2); indent := (!m3);
			      do_break pp saved_indent do_what;
			      m1 := ~1;
			      loop())))
		  | ENDB => ())
      in debug ["P3"];
	 loop()
      end

  and PP (pp as {inp=inp, outp=outp, indent=indent, 
		 m1=m1, m2=m2, m3=m3, ...} :Pp) = 
      let 
      in debug ["PP"];
	 m1 := (!inp); m2 := (!outp); m3 := (!indent);
	 (P1 pp; m1 := ~1; debug ["PP finished"])
	 handle LineTooLong 
	   => (debug ["PP: line too long"];
	       inp := (!m1); outp := (!m2); indent := (!m3);
	       m1 := ~1;
	       P3 pp)
      end

  exception EndbWithNoMatchingSetb
  fun top_level pp = 
      let 
      in debug ["top_level"];
	 P3 pp;
	 raise EndbWithNoMatchingSetb
      end

  (* ----------------------------------------------------------------------- *)
  (*				Interaction				   *)
  (* ----------------------------------------------------------------------- *)

  fun setb pp = enqueue pp SETB

  fun endb pp = enqueue pp ENDB

  fun break pp b i = enqueue pp (BREAK {united=b, do_what=(NLINDENT i)})

  fun expbreak pp b s = enqueue pp (BREAK {united=b, do_what=(EXPLICIT s)})

  fun pwrite (pp as {wr=wr, ...} : Pp) s = 
      (debug ["write: '", s, "'"];
       mapunit (fn s => case ord(s) of
			  10 => break pp true 0
			| i  => enqueue pp (CHAR(i)))
	       (explode s))

  exception IllegalMargin

  fun set_margin (pp as {margin=margin, outp=outp , ...} : Pp) n =
      if (!outp) > n orelse n >= outqlen
	 then raise IllegalMargin
	 else margin := n

  (* ----------------------------------------------------------------------- *)
  (*				  Creation				   *)
  (* ----------------------------------------------------------------------- *)

  fun pp_from_wr wr =
      let val _ = debug ["new"];
	  val (pp as {empty=empty, ...}:Pp) = init_pp wr
      in 
	 callcc (fn k => (empty := k; top_level pp));
	 pp
      end

  fun wr_from_pp (pp as {wr=wr, ...} : Pp)
      = Wr.to_fn (fn s => pwrite pp s) (fn () => Wr.close wr)

  end (* Functor Pp *)

  functor Wr () : WR =
  struct

  datatype wr = 
	  WR of wr_spc * unit

  and wr_spc = 
	  TO_STDOUT
	| TO_FILE of string * outstream
	| TO_WRS of wr list
	| TO_STRING of string list ref
	| TO_FN of (string->unit) * (unit->unit)
	| TO_NOWHERE 

  type Wr = wr

  fun new spc = WR(spc, ())

  fun to_stdout () = new (TO_STDOUT)

  fun to_file name = 
      let val out = open_out name
      in new (TO_FILE(name,out))
      end

  fun to_wrs wrs = new (TO_WRS(wrs))

  fun to_fn f cl_f = new (TO_FN(f,cl_f))

  fun to_string () = new (TO_STRING(ref([]:string list)))

  fun to_nowhere () = new (TO_NOWHERE)

  exception Not_a_TOSTRING_Wr

  fun extract_str (WR(TO_STRING(ss),_)) = implode (rev (!ss))
    | extract_str _ = raise Not_a_TOSTRING_Wr

  fun mapunit f = 
      let fun m ([]) = ()
	    | m (hd::tl) = ((f hd); m tl)
      in m
      end

  fun close (WR(spc,gen)) = 
      case spc of
	 TO_STDOUT => ()
       | TO_FILE(name,out) => close_out out
       | TO_WRS(wrs) => mapunit close wrs
       | TO_FN(_,cl_f) => cl_f()
       | TO_STRING(ss) => ()
       | TO_NOWHERE => ()

  fun write_wr (WR(spc,gen)) s =
      case spc of
	 TO_STDOUT => output(std_out,s)
       | TO_FILE(_,out) => output(out,s)
       | TO_WRS(wrs) => mapunit (fn wr => write_wr wr s) wrs
       | TO_FN(f,_) => f s
       | TO_STRING(ss) => ss := (s :: (!ss))
       | TO_NOWHERE => ()

  end 

Comment: See tests/bug429.1.sml for shortened example.

Status: not a bug ---  caused by illegal redundancy from include specs.
---------------------------------------------------------------------------
Number: 430
Title: Subscript in lookTycPath
Keywords: 
Submitter: Dave MacQueen
Date: 8/3/91
Version: 0.70
Severity: serious
Problem: 
  Following code causes
    $$ lookTycPath 2: [2,0]
    tyconInContext: [2,0]
  messages in d70, indicating Subscript has been raised while
  interpreting a relative type address.
Code: 
  signature S2 =
  sig
    structure A : sig type t end
    datatype u = ITEM of A.t
  end;

  functor F(X : sig type v end ) =
  struct
    type w = X.v
  end;

  functor G(Y : S2) =
  struct
    structure B = F(struct type v = Y.u end)
  end;

Comments:
Problem is bad env passed to redefineCon (typing/functor.sml) during the
application of functor F within the body of G.  The env for the instantiated
body of F is being used to interpret the type of datacon ITEM from the
parameter Y: S2.  lookTycPath aborts with a Subscript exception, which
gets caught by ArrayExt.app in redoTycs.

Status: fixed in 0.73
---------------------------------------------------------------------------
Number: 431
Title: ml_writev
Keywords: 
Submitter: Dave Tarditi
Date: 7/1/91
Version: 0.69
Severity: minor
Problem: 
    The function ml_writev in cfuns.c for version 0.69 appears to have
    a bug; the reference to callc_v in it should have 1 added to it, since
    callc_v is a label that points to the tag of a closure, not
    the closure itself.  By the way, callc_v is defined in the
    header file prim.h.
Fix:
    The diff of the old version with the new version is below.

    570d569
    < 		extern int callc_v[];
    577,578c576,577
    < 		MLState->ml_closure = PTR_CtoML(callc_v);
    < 		MLState->ml_pc	    = CODE_ADDR(PTR_CtoML(callc_v));
    ---
    > 		MLState->ml_closure = PTR_CtoML(callc_v+1);
    > 		MLState->ml_pc	    = CODE_ADDR(PTR_CtoML(callc_v+1));
Status: fixed in 0.74 (or earlier).
---------------------------------------------------------------------------
Number: 432
Title: corrupted (shell) environment
Keywords: 
Submitter: Julian Bradfield <jcb@lfcs.edinburgh.ac.uk>
Date: 7/1/91
Version: 0.66
System: Sparc
Problem: 
    NJ SML version 0.66 (running on Sparc) sometimes corrupts its
    environment: after compiling a piece of code, executed sub-processes get
    an environment with (apparently) random characters added to
    environment values. (The specific piece of code is too long to include
    here; I don't know how general the problem is.)
Comment: [dbm] sent mail asking for code to reproduce the problem.
    This is the same as #342.  [Bradfield confirms that problem is fixed in
    0.75 in mail sent 12/5/91.]
Status: fixed in 0.74 (JHR)
---------------------------------------------------------------------------
Number: 433
Title: lexgen bug
Keywords: 
Submitter: Julian Bradfield <jcb@lfcs.edinburgh.ac.uk>
Date: 7/1/91
Version: 0.66
Problem: 
  In the lexgen.sml distributed with 0.66, there is a bug at line
  1047; when outputting the arguments for the "action" function, there
  should be a test for !UsesTrailingContext . If true, should the third
  argument just be nil ?
Status: fixed in 0.74
---------------------------------------------------------------------------
Number: 434
Title: interactive input
Keywords: 
Submitter: Lawrence Paulson <Larry.Paulson@computer-lab.cambridge.ac.uk>
Date: 1/1/91
Version: 0.66 (and later)
Problem: 
  I think there's something strange with interactive I/O.  Consider the
  following:

  fun prs s = output(std_out,s);
  val pause_tac = Tactic (fn state => 
    (prs"** Press RETURN to continue: ";
     if input(std_in,1) = "\n" then Sequence.single state
     else (prs"Goodbye\n";  Sequence.null)));

  New Jersey ML waits for input and prints the prompt afterwards.  The behavior
  of ML's I/O is not precisely defined, but most languages flush any awaiting
  output before demanding input.

  Really, I would like to accept single-character inputs (rather than lines
  ending with CR) but Standard ML seems to have no suitable primitive!
Status: not a bug, but a sensible request
---------------------------------------------------------------------------
Number: 435
Title: patrow syntax
Keywords: 
Submitter:      Matti Jokinen, moj@utu.fi
Date:		7/28/91
Version:        0.69
System:         Sun 3
Severity:       minor

Problem:        The compiler fails to accept the following patrow syntax:

			id:ty as pat

Code:           fun f {x:int as y} = x;

Transcript:     - fun f {x:int as y} = x;
		Error: Compiler bug: patType -- unexpected pattern

Comments:	The following patterns are translated correctly:

			{x = x:int as y}
			{x as y}
			{x:int}

		I think the bug is caused by a missing branch is in the
		patType function (lines 128-194 in src/typing/typecheck.sml).
		The parser appears to transform `id:ty as pat' into
		LAYEREDpat(CONSTAINTpat(_,ty),pat), which is not recognized
		by patType.
Status: fixed in 0.74
---------------------------------------------------------------------------
Number: 436
Title: debugger type checking
Keywords: 
Submitter:      Sergio Antoy, antoy@cs.pdx.edu
Date:           7/1/91
Version:        0.66
System:         Sparc IPC, SunOS 4.1.1
Problem:        the debugger reports tycon mismatch on a correct program
Code:
  (* dec (x,l) is the string decimal representation of x over l characters,
     right justified. If l characters are not enough, then l "*" are returned.
     If l <= 0, then an exception is raised. *)
  
  exception wrong_field_size
  fun dec (x, l) =
    if l <= 0
      then raise wrong_field_size
      else 
        let fun dok (0, "") = "0"
              | dok (0, s) = s
              | dok (x, s) = dok (x div 10, chr(x mod 10 + ord("0")) ^ s)
            fun fill (s, l) =
              if size s > l
                then
                  let fun dc 0 = ""
                        | dc l = "*" ^ dc (l-1)
                  in
                    dc l
                  end
                else
                  let fun dc 0 = ""
                        | dc l = " " ^ dc (l-1)
                  in
                    dc (l - size s) ^ s
                  end
        in if x < 0
             then fill ( "-" ^ (dok (~x, "")), l)
             else fill (dok (x, ""), l)
        end
  
Transcript:
  Standard ML of New Jersey, Version 0.66, 15 September 1990
  val it = () : unit
  - emacsInit (); cd "/home/antares/pizza/users/antoy/programs/sml/random-dir/";
  val it = () : unit
  val it = () : unit
  - usedbg "format.sml";
  [opening /home/antares/pizza/users/antoy/programs/sml/random-dir/format.sml]
  
  [Major collection... 63% used (1343748/2106244), 1520 msec]
  
  [Increasing heap to 4104k]
  exception wrong_field_size
  val dec = fn : int * int -> string
  [closing /home/antares/pizza/users/antoy/programs/sml/random-dir/format.sml]
  val it = () : unit
  - run "dec(12,4)";
  [opening <instream>]
  <instream>:1.1-1.9 Error: operator and operand don't agree (tycon mismatch)
    operator domain: int ref
    operand:         int * int
    in expression:
      dec (12,4)
  [closing <instream>]
  - dec(12,4);
  val it = "  12" : string
  - 
Comments:	Under epoch 3.2.4
		The debugger works for a trivial factorial program.


From apt@Princeton.EDU Tue Jul  2 10:28:41 1991
This is indeed a (minor) bug, which I'll handle in due course.
The problem seems to be that the run function is hiding the user's 
(re-)definition of dec with the pervasive Integer.dec.
There is a trivial work-around: call the user function something different.

Status: fixed in    0.88
---------------------------------------------------------------------------
Number: 437
Title: mlyacc syntax problem
Keywords: 
Submitter: Andrew Wright <wright@rice.edu>
Date: 7/3/91
Version: 0.69
Problem: 
The source file "yacc.sml" of mlyacc from the 0.69 release does not compile
under the 0.69 release because of a syntax error at line 350:

		     EAPP(EVAR(valueStruct^"."^
			     if hasType (NONTERM lhs)
				  then saySym(NONTERM lhs)
                                  else ntvoid),
Fix:
The "if then else" needs to be parenthesized.

Status: fixed in 0.73
---------------------------------------------------------------------------
Number: 438
Title: callcc typing unsound
Keywords: 
Submitter: Robert Harper <rwh@proof.ergo.cs.cmu.edu>
Date: 7/3/91
Version: 0.70
Severity: critical
Problem: 
  Recently Mark Lillibridge and I have been trying to investigate a
  number of questions of type soundness in the presence of polymorphism
  and control operators.  As you may recall, I have been unable to find
  a cps transform that (1) is faithful to the ML operational semantics,
  and (2) admits a suitable typing result to guarantee soundness in
  Milner's sense.  We discovered that the central issue is to do with
  the scope of type variables.  This got us to thinking, and late last
  night Mark came up with the following example which demonstrates that
  ML with callcc and polymorphism is UNSOUND.  Run it in SML/NJ to see
  what I mean.  We plan to investigate the matter further, and will keep
  you posted.
Code: 
  fun left (x,y) = x;
  fun right (x,y) = y;

  let val later = (callcc (fn k =>
	  (  fn x => x,  fn f => throw k (f, fn f => ())  ) ))
  in
	  print (left(later)"hello");
	  right(later)(fn x => x+2)
  end
Fix:
  Making the type of callcc weakly polymorphic appears to fix the problem.
Status: fixed in 0.73 (by making callcc weakly polymorphic)
---------------------------------------------------------------------------
Number: 439
Title: lexgen
Keywords: 
Submitter: Julian Bradfield <jcb@lfcs.edinburgh.ac.uk>
Date: 7/8/91
Version: 0.66
Problem: 
  lexgen.sml distributed with NJ SML 0.66, lines 983 to 986.
  The variable i in the pattern clashes with i in a pattern much higher
  up. I *think* that all occurrences of i in these four lines should be 
  k, say, while the i on line 987 is indeed i.
  (The symptom of this bug is uncaught Substring exceptions, when a
  state identifier gets passed as a length to accept.)

  Has anybody got the look-ahead facility of ML-Lex to work?
Comment: Tarditi noticed that the ASU lookahead algorithm is buggy, so
	 this feature has been removed.
Status: fixed in 0.74
---------------------------------------------------------------------------
Number: 440
Title: missing Perv.mos
Keywords: 
Submitter:  Matti Jokinen, moj@utu.fi
Date:	    6/15/91
Version:    0.69, 0.70, possibly others
System:     all
Severity:   major

Problem:    File src/runtime/Perv.mos is missing.
	    Consequently, `makeml -pervshare' fails.

Command:    makeml -sun3 sunos -pervshare

Transcript: makeml -sun3 sunos -pervshare
	    ./makeml> (cd runtime; make clean)
	    rm -f *.o lint.out prim.s linkdata allmo.s run
	    ./makeml> rm -f mo
	    ./makeml> ln -s ../mo.m68 mo
	    ./makeml> (cd runtime; rm -f run allmo.o allmo.s)
	    ./makeml> (cd runtime; make MACHINE=M68  'CFL=-n ' 'DEFS= -DBSD -Dsun3 -DSUNOS -
	    DRUNTIME=\"runtime\"' linkdata)
	    cc -O -n -DM68 -DBSD -Dsun3 -DSUNOS -DRUNTIME=\"runtime\" -o linkdata linkdata.c
	    (cd runtime; grep -v mo/Math.mo Perv.mos > Tmp.mos)
    --->    grep: Perv.mos: No such file or directory
	    ./makeml> runtime/linkdata [runtime/Tmp.mos]
	    runtime/linkdata> as runtime/allmo.s -o runtime/allmo.o
	    ./makeml> (cd runtime; make  MACHINE=M68  'DEFS= -DBSD -Dsun3 -DSUNOS' CPP=/lib/
	    cpp 'CFL=-n ' 'AS=as')
	    cc -O -n -DM68 -DBSD -Dsun3 -DSUNOS  -target sun3 -c  run.c
	    cc -O -n -DM68 -DBSD -Dsun3 -DSUNOS  -target sun3 -c  run_ml.c
	    cc -O -n -DM68 -DBSD -Dsun3 -DSUNOS  -target sun3 -c  callgc.c
	    cc -O -n -DM68 -DBSD -Dsun3 -DSUNOS  -target sun3 -c  gc.c
	    cc -O -n -DM68 -DBSD -Dsun3 -DSUNOS  -target sun3 -c  M68.dep.c
	    cc -O -n -DM68 -DBSD -Dsun3 -DSUNOS  -target sun3 -c  export.c
	    cc -O -n -DM68 -DBSD -Dsun3 -DSUNOS  -target sun3 -c  timers.c
	    cc -O -n -DM68 -DBSD -Dsun3 -DSUNOS  -target sun3 -c  ml_objects.c
	    cc -O -n -DM68 -DBSD -Dsun3 -DSUNOS  -target sun3 -c  cfuns.c
	    cc -O -n -DM68 -DBSD -Dsun3 -DSUNOS  -target sun3 -c  cstruct.c
	    cc -O -n -DM68 -DBSD -Dsun3 -DSUNOS  -target sun3 -c  signal.c
	    cc -O -n -DM68 -DBSD -Dsun3 -DSUNOS  -target sun3 -c  exncode.c
	    cc -O -n -DM68 -DBSD -Dsun3 -DSUNOS  -target sun3 -c  malloc.c
	    /lib/cpp -DASM -DM68 -DBSD -Dsun3 -DSUNOS M68.prim.s > prim.s
	    as -o prim.o prim.s
	    cc -O -n -DM68 -DBSD -Dsun3 -DSUNOS -o run run.o run_ml.o callgc.o gc.o M68.dep.
	    o export.o timers.o  ml_objects.o cfuns.o cstruct.o signal.o exncode.o malloc.o
	    prim.o allmo.o
	    Undefined
	    _datalist
	    *** Error code 2
	    make: Fatal error: Command failed for target `run'

Fix:	    Copy the missing file from distribution 0.66.
Status: fixed in 0.73
---------------------------------------------------------------------------
Number: 441
Title: parsing large positive integers
Keywords: 
Submitter:      Olaf Burkart <burkart@zeus.informatik.rwth-aachen.de>
Date:           7/16/90
Version:        0.69
System:         SPARC, SunOS 4.1
Problem:
I have found the following bug in sml 0.69:

Can't parse large positive integers.
Can't load the Edinburgh SML Library.

Problem (1):        2^30 - 1 (maxint) could not be read
-----------
Transcript:     

Standard ML of New Jersey, Version 0.69, 3 April 1991
- ~1073741824;
val it = ~1073741824 : int
- 1073741823;

uncaught exception Overflow
- 
Comment: [dbm] Is this the same as bug 327, which is claimed to be fixed in 0.69?
Status: fixed in 0.72 --- This is related to bug 327 and 444 [lg].
---------------------------------------------------------------------------
Number: 442
Title: Runbind exception
Keywords: 
Submitter:      Olaf Burkart <burkart@zeus.informatik.rwth-aachen.de>
Date:           7/16/90
Version:        0.69
System:         SPARC, SunOS 4.1
Problem:
It seems to me that the Runbind error from BUG 262. is back again.
I tried to load the Edinburgh SML Library, but after fixing problem (1)
the sml interpreter aborts with "uncaught exception Runbind" in the structure
definition:

structure Int: INT =
struct
	...
  exception Overflow = Overflow
  and Div = Div
	...
end
Fix: probably fixed; can't check without source (related bug 419 is fixed)
Status: fixed in 0.75
---------------------------------------------------------------------------
Number: 443
Title: equality attributes in datatype specs
Keywords: 
Submitter: Colin Meldrum <colin@harlqn.co.uk>
Date: 7/17/91
Version: 0.66
Problem: 
In New Jersey v66, the following signature does not elaborate:

signature S =
  sig
    type 'a s

    datatype t = A of int -> int

    datatype
      v = D of w s
    and
      w = E of t
  end

It gives the error:

std_in:16.5-24.2 Error: inconsistent equality properties

However, by swapping the two datdesc clauses in the final datatype spec the
signature can be made to elaborate correctly:

signature S =
  sig
    type 'a s

    datatype t = A of int -> int

    datatype
      w = E of t
    and
      v = D of w s
  end

Status: fixed in 0.73
---------------------------------------------------------------------------
Number: 444
Title: large constants and Overflow
Keywords: 
This is an supplement to the bug:
	327 large constants cause overflow in compilation
	from Apr 23.
Submitter: 
	Juergen Buntrock,
	TU-Berlin,
	jubu@cs.tu-berlin.de
Date: 4/23/91
Version: 0.70
System: Sun4-60 / SunOS Release 4.1.1
Problem: 
	The function primops in (cps/cpsopt.sml line 658) transforms
	integer compare operation somtimes in arithmetic
	operations which may raise Overflow.

	An example is function sizeImmed (in sparc/sparc.sml).
	This functions raise an Overflow  for constant values
	bigger than (maxinit-4096)


Script:
Script started on Tue Jul 30 12:57:30 1991
jubu@flp 1) smln70
Standard ML of New Jersey, Version 0.70, 1 July 1991
val it = () : unit
- structure TT = struct
=     datatype A = A | B
=     fun sizeImmed n = if (~4096 <= n) andalso(n < 4096)
=         then A else B
=     val sizeImmed = fn n =>
=         (sizeImmed n) handle Overflow => (
=             outputc std_out (implode[
=                 "sizeImmed(",makestring n,
=                 ") overflow!\n"]);
=             raise Overflow )
=     val x = 107374182
=     val z = (sizeImmed (x * 10 + 2))
=     end
= ;
sizeImmed(1073741822) overflow!

uncaught exception Overflow

Status: fixed in 0.72 This is had to do with an illegal 
        optimization and a bug in the sparc code generator [lg].
---------------------------------------------------------------------------
Number: 445
Title: spurious error report
Keywords: modules, signatures, error messages
Submitter: Andrew Tolmach <apt@cs.princeton.edu>
Date: 7/30/91
Version: 0.70
Problem: 
  Following produces a spurious error in 0.70.
Code: 

  signature  T = 
  sig
   datatype debuglevel = A of instream option
  end

Status: fixed in 0.73
---------------------------------------------------------------------------
Number: 446
Title: Compiler bug
Keywords: 
Submitter:      jont%uk.co.harlqn@uk.ac.ukc
Date:		01/08/91
Version:        SML of NJ version number 0.66
System:         Sun 4/330 with SunOS 4.1.1
Severity:       minor
Problem:        Compiler warns of compiler bug in compiling some
		incorrect code
Code:
(* _mirprint.sml the functor *)
(*
$Log$
Revision 1.1  2001/10/04 13:38:40  macqueen
Initial revision

Revision 1.3  91/07/30  16:22:11  jont
Printed more opcodes (branch and cgt)

Revision 1.2  91/07/26  20:00:13  jont
Redid some printing in light of changes in mirtypes

Revision 1.1  91/07/25  15:45:09  jont
Initial revision

Copyright (c) 1991 Harlequin Ltd.
*)

require "../utils/integer";
require "../basics/identprint";
require "../lambda/pretty";
require "../lambda/lambdasub";
require "mirtypes";
require "mirprint";

functor MirPrint(
  structure Integer : INTEGER
  structure IdentPrint : IDENTPRINT
  structure MirTypes : MIRTYPES
  structure Pretty : PRETTY
  structure LambdaSub : LAMBDASUB
  sharing IdentPrint.Ident = MirTypes.Ident
  hsaring MirTypes.LambdaTypes = LambdaSub.LambdaTypes
) : MIRPRINT =
struct
  structure MirTypes = MirTypes
  structure P = Pretty

  exception pretty_not_done_yet

  fun decode_binary MirTypes.ADD = "ADD "
  | decode_binary MirTypes.SUB = "SUB "
  | decode_binary MirTypes.MUL = "MUL "
  | decode_binary MirTypes.DIV = "DIV "
  | decode_binary MirTypes.REM = "REM "
  | decode_binary MirTypes.AND = "AND "
  | decode_binary MirTypes.OR = "OR "
  | decode_binary MirTypes.EOR = "EOR "
  | decode_binary MirTypes.SHL = "SHL "
  | decode_binary MirTypes.SHR = "SHR "
  | decode_binary MirTypes.SHRL = "SHRL "
  | decode_binary MirTypes.DIVL = "DIVL "
  | decode_binary MirTypes.REML = "REML "

  fun decode_unary MirTypes.CMP = "CMP "
  | decode_unary MirTypes.CMPL = "CMPL "
  | decode_unary MirTypes.MOV = "MOV "
  | decode_unary MirTypes.NEG = "NEG "
  | decode_unary MirTypes.NOT = "NOT "

  fun decode_store MirTypes.LDX = "LDX "
  | decode_store MirTypes.STX = "STX "

  fun decode_allocate MirTypes.ALLOC = "ALLOC "
  | decode_allocate MirTypes.ALLOC_REAL = "ALLOC_REAL "
  | decode_allocate MirTypes.ALLOC_STRING = "ALLOC_STRING "

  fun decode_branch MirTypes.BRA = "BRA "
  | decode_branch MirTypes.BEQ = "BEQ "
  | decode_branch MirTypes.BNE = "BNE "
  | decode_branch MirTypes.BHI = "BHI "
  | decode_branch MirTypes.BLS = "BLS "
  | decode_branch MirTypes.BHS = "BHS "
  | decode_branch MirTypes.BLO = "BLO "
  | decode_branch MirTypes.BGT = "BGT "
  | decode_branch MirTypes.BLE = "BLE "
  | decode_branch MirTypes.BGE = "BGE "
  | decode_branch MirTypes.BLT = "BLT "
  | decode_branch MirTypes.BVS = "BVS "
  | decode_branch MirTypes.BVC = "BVC "
  | decode_branch MirTypes.BMI = "BMI "
  | decode_branch MirTypes.BPL = "BPL "

  fun decode_adr MirTypes.LEA = "LEA "

  fun decode_real_gc(MirTypes.GC_REAL gc_reg) =
    "REG " ^ MirTypes.print_gc_register gc_reg
  | decode_real_gc(MirTypes.GC_SPILL i) =
    "SPILL " ^ Integer.makestring i

  fun decode_real_non_gc(MirTypes.NON_GC_REAL gc_reg) =
    "REG " ^ MirTypes.print_non_gc_register gc_reg
  | decode_real_non_gc(MirTypes.NON_GC_SPILL i) =
    "SPILL " ^ Integer.makestring i

  fun decode_reg_operand(MirTypes.GC_REG(gc_reg, real_gc_reg_opt)) =
    "GC(" ^ MirTypes.print_gc_register gc_reg ^
    (case real_gc_reg_opt of
      MirTypes.ABSENT => ""
    | MirTypes.PRESENT real_gc => decode_real_gc real_gc)
    ^ ") "
  | decode_reg_operand(MirTypes.NON_GC_REG(non_gc_reg, real_non_gc_reg_opt)) =
    "NON_GC(" ^ MirTypes.print_non_gc_register non_gc_reg ^
    (case real_non_gc_reg_opt of
      MirTypes.ABSENT => ""
    | MirTypes.PRESENT real_non_gc => decode_real_non_gc real_non_gc)
    ^ ") "

  fun decode_gp_op(MirTypes.GP_GC_REG(gc_reg, real_gc_reg_opt)) =
    "GC(" ^ MirTypes.print_gc_register gc_reg ^
    (case real_gc_reg_opt of
      MirTypes.ABSENT => ""
    | MirTypes.PRESENT real_gc => decode_real_gc real_gc)
    ^ ") "
  | decode_gp_op(MirTypes.GP_NON_GC_REG(non_gc_reg, real_non_gc_reg_opt)) =
    "NON_GC(" ^ MirTypes.print_non_gc_register non_gc_reg ^
    (case real_non_gc_reg_opt of
      MirTypes.ABSENT => ""
    | MirTypes.PRESENT real_non_gc => decode_real_non_gc real_non_gc)
    ^ ") "
  | decode_gp_op(MirTypes.GP_IMM_INT imm) =
    "Int(" ^ Integer.makestring imm ^ ") "
  | decode_gp_op(MirTypes.GP_IMM_ANY imm) =
    "Any(" ^ Integer.makestring imm ^ ") "

  fun decode_op(MirTypes.BINARY(binary_op, reg_op, gp_op1, gp_op2)) =
    decode_binary binary_op ^ decode_reg_operand reg_op ^
    decode_gp_op gp_op1 ^ decode_gp_op gp_op2
  | decode_op(MirTypes.UNARY(unary_op, reg_op, gp_op)) =
    decode_unary unary_op ^ decode_reg_operand reg_op ^ decode_gp_op gp_op
  | decode_op(MirTypes.STOREOP(store_op, reg_op1, reg_op2, gp_op)) =
    decode_store store_op ^ decode_reg_operand reg_op1 ^
    decode_reg_operand reg_op2 ^ decode_gp_op gp_op
  | decode_op(MirTypes.ALLOCATE(allocate, gc_reg, imm)) =
    decode_allocate allocate ^ "GC(" ^ MirTypes.print_gc_register gc_reg ^
    ") " ^
    (case allocate of MirTypes.ALLOC_REAL => "" | _ => Integer.makestring imm)
  | decode_op(MirTypes.BRANCH(branch, tag)) =
    decode_branch branch ^ MirTypes.print_tag tag
  | decode_op(MirTypes.SWITCH(cgt, reg_op, tag_list)) =
    LambdaSub.reduce_left
    (fn (s, tag) => s ^ " " ^ MirTypes.print_tag tag)
    ("CGT " ^ decode_reg_operand reg_op, tag_list)
  | decode_op(MirTypes.VALUE scon) = (case scon of
      IdentPrint.Ident.REAL _ => "Real "
    | IdentPrint.Ident.STRING _ => "String "
    | _ => raise(LambdaSub.LambdaTypes.impossible"VALUE(int)")) ^ 
    IdentPrint.printSCon scon
  | decode_op(MirTypes.ADR(adr, reg_op, tag)) =
    decode_adr adr ^ decode_reg_operand reg_op ^ " " ^ MirTypes.print_tag tag
    (* Information points *)
  | decode_op(MirTypes.LOC_REF tag_list) =
    LambdaSub.reduce_left op ^
    ("Local references\n",
      map (fn tag => MirTypes.print_tag tag ^ " ") tag_list)
  | decode_op MirTypes.END = "End of code"
  | decode_op _ = raise(pretty_not_done_yet)
(*
  | decode_op(MirTypes.BINARYFP of binary_fp_op * fp_register * fp_register * fp_operand |
  | decode_op(MirTypes.UNARYFP of unary_fp_op * fp_register * fp_operand |
  | decode_op(MirTypes.STACKOP of stack_op * reg_operand |
  | decode_op(MirTypes.STOREFPOP of store_fp_op * fp_register * reg_operand * gp_operand |
  | decode_op(MirTypes.CONVOP of int_to_float * fp_register * reg_operand |
  | decode_op(MirTypes.BRANCH_AND_LINK of branch_and_link * bl_dest |
  | decode_op(MirTypes.INIT of any_register | (* Register is initialised here *)
  | decode_op(MirTypes.USE of any_register | (* Register is used here *)
  | decode_op(MirTypes.ENTER of int * reg_operand |
    (* Entry point for procedure, with n locals and arg reg *)
  | decode_op(MirTypes.EXIT of reg_operand | (* Return point from procedure, result in reg *)
    (* Data *)
*)

  fun decode_block(MirTypes.BLOCK(tag, op_list)) =
    P.blk(0, P.lst("", [P.nl], "")
      (P.blk(2, [P.str("Tag "), P.str(MirTypes.print_tag tag)]) ::
        (map (fn x => P.str("  " ^ decode_op x)) op_list)))

  fun print_mir_code(MirTypes.CODE block_list) =
    P.string_of_T(P.blk(0, P.lst("", [P.nl], "")
			(map decode_block block_list)))
end

Transcript:
make "../mir/_mirprint.sml";
[opening /home/ml/jont/ml/ml_compiler/src/mir/_mirprint.sml]
val it = () : unit
val it = () : unit
val it = () : unit
val it = () : unit
val it = () : unit
val it = () : unit
/home/ml/jont/ml/ml_compiler/src/mir/_mirprint.sml:30.3-30.9 Error: syntax error: inserting OPEN
/home/ml/jont/ml/ml_compiler/src/mir/_mirprint.sml:30.3-30.54 Error: unbound structure in signature: hsaring
/home/ml/jont/ml/ml_compiler/src/mir/_mirprint.sml:30.3-30.54 Error: unbound structure in signature: MirTypes.LambdaTypes
Error: Compiler bug: lookPathSTRinSig.get
[closing /home/ml/jont/ml/ml_compiler/src/mir/_mirprint.sml]

Comments:	The code is incorrect, but it shouldn't cause the
compiler to claim it has a bug in itself! The cause seems somewhat
related to the fact that MirTypes has no substructure LambdaTypes,
simply misspelling sharing on a line which is an otherwise valid
sharing constraint line does not exhibit the problem.

Status: fixed in 0.73?  (incomplete source, can't test)
---------------------------------------------------------------------------
Number: 447
Title: identity type abbreviation
Keywords: 
Submitter:      tmb@ai.mit.edu
Date:           08/02/91
Version:        0.70
System:         Sun4/OS4.1.1
Severity:       ?
Problem:        the type checker refuses to accept the following definition
Code:

structure S =
    struct
	type 'b data = 'b list
	type 'b value = 'b
	fun at(x:'b data):'b value = hd x
    end;

Transcript:

   hack.sml:5.2-5.34 Error: expression and constraint don't agree (bound type var)
     expression: 'bU
     constraint: 'bU value
     in expression:
       Initial.hd x

Comments:

   I'm not sure whether this is a bug, but certain types of functors
   seem to be difficult to express if you cannot write definitions like
   this.

   In particular, it seems like I have to write two separate functors
   depending on whether "'b value" is simply "'b" or whether it
   is some other type dependent on "'b" (e.g., "'b list"). This
   seems very unnatural.

signature S =
    sig
	type 'a data
	type 'a value
	val at: 'b data -> 'b value
    end;

functor F(structure X:S) =
    struct
	open X
	fun pair_at x = (at x,at x)
    end;

structure A =
    struct
	type 'a data = 'a list
	type 'a value = 'a list
	val at = (fn x => x)
    end;

structure FA = F(structure X = A);
    
structure B =
    struct
	type 'a data = 'a list
	type 'a value = 'a
	val at = hd
    end;

(* why can't I do this??? *)

structure FB = F(structure X = B);
Fix: type abbreviations must be expanded when unifying with UBOUND type variables
     in Unify (basics/unify.sml).  The definition of equalTypes in TypesUtil
     must be changed in a similar manner.
Status: fixed in 0.74
---------------------------------------------------------------------------
Number: 448
Title: failure to build on MIPS 6280
Keywords: 
Submitter: Dave MacQueen
Date: 8/10/91
Version: 0.71
System: MIPS 6280, RISCOS 4.52
Severity: critical (for 6280)
Problem: failure while trying to bootstap the compiler
Transcript: 
  % makeml -mips riscos -batch -m 60000 
  makeml> (cd runtime; make clean)
	  rm -f *.o lint.out prim.s linkdata allmo.s run
  makeml> rm -f mo
  makeml> ln -s ../mo.mipsb mo
  makeml> (cd runtime; rm -f run allmo.o allmo.s)
  makeml> (cd runtime; make MACHINE=MIPS  'CFL= -systype bsd43' 'LIBS=' 'DEFS= -DRISCos -DRUNTIME=\"runtime\"' linkdata)
	  cc -O -systype bsd43 -DMIPS -DRISCos -DRUNTIME=\"runtime\" -o linkdata linkdata.c
  makeml> runtime/linkdata [runtime/CompMipsBig.mos]
  runtime/linkdata> as runtime/allmo.s -o runtime/allmo.o
  makeml> (cd runtime; make  MACHINE=MIPS  'DEFS= -DRISCos' 'CPP=/lib/cpp -P' 'CFL= -systype bsd43' 'AS=as' 'LIBS=')
	  cc -O -systype bsd43 -DMIPS -DRISCos -c run.c
	  cc -O -systype bsd43 -DMIPS -DRISCos -c run_ml.c
	  cc -O -systype bsd43 -DMIPS -DRISCos -c callgc.c
	  cc -O -systype bsd43 -DMIPS -DRISCos -c gc.c

  uopt: Warning: gc: this procedure not optimized because it
	exceeds size threshold; to optimize this procedure, use -Olimit option
	with value >=  553.
	  cc -O -systype bsd43 -DMIPS -DRISCos -c MIPS.dep.c
	  cc -O -systype bsd43 -DMIPS -DRISCos -c export.c
	  cc -O -systype bsd43 -DMIPS -DRISCos -c timers.c
	  cc -O -systype bsd43 -DMIPS -DRISCos -c ml_objects.c
	  cc -O -systype bsd43 -DMIPS -DRISCos -c cfuns.c
	  cc -O -systype bsd43 -DMIPS -DRISCos -c cstruct.c
	  cc -O -systype bsd43 -DMIPS -DRISCos -c signal.c
	  cc -O -systype bsd43 -DMIPS -DRISCos -c exncode.c
	  cc -O -systype bsd43 -DMIPS -DRISCos -c malloc.c
	  cc -O -systype bsd43 -DMIPS -DRISCos -c mp.c
	  cc -O -systype bsd43 -DMIPS -DRISCos -c sync.c
	  /lib/cpp -P -DASM -DMIPS -DRISCos MIPS.prim.s > prim.s
	  as -o prim.o prim.s
  as0: Warning: prim.s, line 281: missing .end preceding this .ent: set_request
	.ent set_request
  as0: Warning: prim.s, line 281: .ent/.end block never defined the procedure name
  as0: Warning: prim.s, line 407: missing .end preceding this .ent: go
	.ent go
	  cc -O -systype bsd43 -DMIPS -DRISCos -o run run.o run_ml.o callgc.o gc.o MIPS.dep.o export.o timers.o  ml_objects.o cfuns.o cstruct.o signal.o exncode.o malloc.o  mp.o sync.o prim.o allmo.o 
  makeml> runtime/run -m 60000 -r 5 -h 2048 CompMipsBig

  [Increasing heap to 2048k]
  [Loading mo/CoreFunc.mo]
  [Executing mo/CoreFunc.mo]
  [Loading mo/Math.mo]
  [Executing mo/Math.mo]
  [Loading mo/Initial.mo]
  [Executing mo/Initial.mo]
  Uncaught exception CFunNotFound with "argv"
  9.2u 7.8s 1:22 20% 182+737k 1269+1532io 2586pf+0w

Comments:
  The as0 warnings should be eliminated, and the -Olimit flag added or changed
  so that the gc code can be optimized.
Status: fixed in 0.78
---------------------------------------------------------------------------
Number: 449
Title: poor error message for mismatching datatype spec
Keywords: 
Submitter: John Reppy (jhr@cs.cornell.edu)
Date: 3/5/91
Version: 0.66-0.69
Severity: minor
Problem: 

Here is another example of an error message that doesn't give enough
info:

  user/drawing.sml:9.3-12.5 Error: mismatching datatype spec: pen_val_t

In this case, pen_val_t has ~30 variants; figuring out the mismatch is
a pain.  This is like the problem with large labeled records.
  - John
Status: fixed in 0.91 (dbm)
---------------------------------------------------------------------------
Number: 450
Title: Compiler bug: tycPath
Keywords: 
Submitter: Andy Koenig (dopey!ark)
Date: 10/16/91
Version: 0.66
Severity: minor
Problem: After an unmatched type spec there is a Compiler bug message.
Transcript: 
  - signature I = sig type T end;
  signature I =
    sig
      type T
    end
  - abstraction J : I = struct type u = int end;
  std_in:1.21-1.43 Error: unmatched type spec: T
  Error: Compiler bug: tycPath
Status: fixed in 0.74
---------------------------------------------------------------------------
Number: 451
Title: sharing constraints
Keywords: 
Submitter: Mike Crawley <mjc@abstract-hardware-ltd.co.uk>
Date: 10/29/91
Version: 0.73
Severity: serious
Problem: 
  SML/NJ 0.73 gets the sharing constraints wrong in the following ML.
Code: 
  signature A = sig structure Base:sig end end;

  signature P = sig end;

  functor A (structure P:P) : A =
  struct
    structure Base = P;
  end;

  signature B = sig structure Base:sig end end;

  functor B (structure P:P structure A:A sharing P = A.Base ) : B =
  struct
    structure Base = P;
  end;

  functor Q(structure P : P
	    structure A : A 
	    structure B : B 
	    sharing P = A.Base = B.Base) = struct end ;

  structure P = struct end ;

  structure A = A(structure P = P);
  structure B = B(structure P = P structure A = A);

  structure Q = Q(structure P = P
		  structure A = A
		  structure B = B);

Status: fixed in 0.75
---------------------------------------------------------------------------
Number: 452
Title: finding out what is in a structure
Keywords: 
Submitter:      Tim Freeman, tsf@cs.cmu.edu
Date:		10/30/91
Version:        0.74
System:         Sun 4
Severity:       minor but chronic
Problem:        I used to be able to find out what was in a structure
		by opening it up.  Now there is apparently no way to
		remind myself of what is in a structure other than by
		reading the source.
Transcript:     - structure x = SourceGroup;
		structure x : SOURCEGROUP
		(* This used to tell me all of the things in the
		SourceGroup structure. *)
		- open x;
		open x
		(* I would be just as happy if this printed out the
		information I want too. *)
Comments:	Maybe this feature should have its own name, instead
		of hanging off of top level structure declarations.
Status: not a bug
---------------------------------------------------------------------------
Number: 453
Title: unhandled exception crashes sml
Keywords: 
Submitter:      Tim Freeman <tsf@cs.cmu.edu>
Date:		10/31/91
Version:        0.74
System:         Sun 4 running some version of Mach
Severity:       minor
Problem:        With some manipulations of structures, raising
		unhandled exceptions causes SML to bomb.
Code:           bug3.sml contains:
		structure Util = 
		    struct
			exception Bug of string
		    end
		
		structure InstProto = 
		struct
		    structure U = Util
		    structure S = struct end 
		end 
		
		open InstProto
		;
		raise U.Bug "hi"

Transcript:     % sml
		Standard ML of New Jersey, Version 0.74, 10 October, 1991
		Prerelease version.  Arrays have changed; see doc/NEWS
		val it = () : unit
		- use "bug3.sml";
		[opening bug3.sml]
		structure Util : 
		  sig
		    exception Bug of string
		  end
		structure InstProto : 
		  sig
		    structure S : ...
		    structure U : ...
		  end
		open InstProto
		SIGILL code 0x7
		% 				
Comments:	Earlier during the process of narrowing down this bug,
		it was saying 

			uncaught exception random binary garbage

		(except you have to imagine the string "random binary
		garbage" replaced by random binary garbage) instead of
		getting the SIGILL trap. 
Status: fixed in 0.75
---------------------------------------------------------------------------
Number: 454
Title: running out of memory
Keywords: 
Submitter: Andy Koenig
Date: 11/7/91
Version: 0.74
System: SPARCstation, 64MB
Severity: minor
Problem: 
  SML-NJ is not very nice about handling memory exhaustion.
Transcript: 

	[boojum] sml
	Standard ML of New Jersey, Version 0.74, 10 October, 1991
	Prerelease version.  Arrays have changed; see doc/NEWS
	val it = () : unit
	- fun f x = f(0::x);
	val f = fn : int list -> 'a
	- f nil;

	[Increasing heap to 3164k]

	[Increasing heap to 4452k]

	[Increasing heap to 5456k]

	[Major collection...
	[Increasing heap to 8192k]
	 76% used (3427160/4508104), 2610 msec]

	[Increasing heap to 13192k]

	[Major collection... 49% used (4497848/8999168), 4600 msec]

	[Increasing heap to 26380k]

	[Major collection... 49% used (8999168/18002072), 9250 msec]

	[Increasing heap to 27204k]

	[Major collection...
	[Increasing heap to 27620k]

	[Increasing heap to 27776k]

	[Increasing heap to 27860k]

	[Increasing heap to 27880k]

	Warning: can't increase heap

	Ran out of memory[boojum] 
Comments:
    While I do ultimately expect some kind of drastic termination,
    I do **NOT** expect to be unceremoniously dumped out of ML back
    into the Shell.  A more reasonable strategy might be to preallocate
    a chunk of memory to be used as secondary storage while recovering
    from exhaustion of primary storage.  That, at least, would allow
    for a return to top level and associated garbage collection, which,
    in many cases, would allow interactive execution to resume.

    Incidentally, this example was run on a Sparcstation with 64
    megabytes of physical memory and no limit on process size
    that I know of.  I don't know why it gave up the ghost at
    28 megabytes -- do you?
Owner: 
Status: open
---------------------------------------------------------------------------
Number: 455
Title: handling Real.Div
Keywords: 
Submitter:      olender@cs.colostate.edu <Kurt Olender>
Date:           11/11/91
Version:        0.75
System:         Sparcstation-2/SunOS 4.1.1
Severity:       minor
Problem:        cannot handle Real.Div exception
Code:           1.0/0.0 handle Real.Div => 10.0;
Transcript:     
        (* At top level *)
        (* Integer works *)
        - 1 div 0 handle Integer.Div => 10;
        val it = 10 : int

        (* Real doesn't *)
        - 1.0/0.0 handle Real.Div => 10.0;

        uncaught exception Div

        (* Even when I don't specify the name *)
        - 1.0/0.0 handle _ => 10.0;

        uncaught exception Div
Fix:
  This was a bug in the scheduler dependencies for the SPARC.
Status: fixed in 0.76
---------------------------------------------------------------------------
Number: 456
Title: signals on SPARC cause heap corruption
Keywords: 
Submitter:      tyan@cs.cornell.edu & Greg_Morrisett@CS.CMU.EDU
Date:           11/20/91
Version:        0.75 (and earlier)
System:         Sparc
Severity:       minor
Problem:        programs using signals to do pre-emption get corrupted heaps.
Code:
(* A simple preemptive thread structure *)
structure T =
    struct
	(* Queues *)
	type '1a queue = ('1a list ref * '1a list ref)
	fun create () = (ref [], ref [])
	fun enq ((f,r), x) = r := x :: (!r)
	fun deq (f,r) = 
	    (case (!f) of
		 (hd::tl) => (f := tl; SOME hd)
	       | [] => (case (rev (!r)) of
			    (hd::tl) => (f := tl; r := [];
					 SOME hd)
			  | [] => NONE))

	(* Flag for atomicity *)
	val atomic = ref false

	(* Ready queue *)
	val ready : unit cont queue = create ()

	exception Deadlock

	fun enterAtomic () = atomic := true
	fun leaveAtomic () = atomic := false

	fun reschedule k = enq (ready, k)

	fun get_next () = 
	    case (deq ready) of
		NONE => raise Deadlock
	      | SOME k => k

	(* fork a thread *)
	fun fork f =
	    (enterAtomic ();
	     callcc (fn c => (reschedule c;
			      leaveAtomic ();
			      f ();
			      enterAtomic ();
			      throw (get_next ()) ()));
	     leaveAtomic ())

	fun prepend f kont = 
	    (callcc (fn c => (callcc (fn k => (throw c k));
			      f ();
			      throw kont ())))

	(* context switch signal handler *)
	fun handler (n,kont) = 
	    if (!atomic) then (kont)
	    else
		(enterAtomic ();
		 reschedule (prepend leaveAtomic kont);
		 get_next ())

	local
	    open System.Signals System.Timer System.Unsafe.CInterface
	    val t0 = TIME {sec=0,usec=0}
	in
	    val _ = setHandler (SIGALRM, SOME handler)

	    fun setPreempt NONE = setitimer(0,t0,t0)
	      | setPreempt (SOME t) =
		let val t = TIME {sec=0,usec=1000*t}
		in
		    setitimer(0,t,t)
		end
	end

    end

fun spin_alloc l = spin_alloc (rev l);  (* make sure we fool compiler *)
fun spin () = spin_alloc [1,2];

fun bug () = (T.setPreempt (SOME 50);
	      T.fork spin; T.fork spin; T.fork spin)

Fix:
  The problem was that the SPARC has no callee saved FP registers, so the
  resumption continuation was pointing to its own descriptor.

Status: fixed in 0.76
---------------------------------------------------------------------------
Number: 457
Title: Real.ceiling has wrong type
Keywords: 
Submitter:      Lal George
Date:           11/22/91
Version:        0.75 (and earlier)
System:         all
Severity:       minor
Problem:        Real.ceiling has wrong type
Code:
  - ceiling;
  val it = fn : real -> 'a
Remark:
  yet another example of the brain damage in perv.sml
Status: fixed in 0.76
---------------------------------------------------------------------------
Number: 458
Title: incorrect 'Warning: binding not exhaustive' message
Keywords: 
Submitter:      Lal George
Date:		11/27/91
Version:        0.75 (and earlier)
System:         all
Severity:       minor
Code:           

	datatype register = Reg of int | Freg of int
	datatype ea = Direct of register | Immed of int 
	val dataptr as Direct dataptr' = Direct(Reg 23)

Transcript: 
    
- val dataptr as Direct dataptr' = Direct(Reg 23);
std_in:4.1-4.47 Warning: binding not exhaustive
        dataptr as Direct dataptr' = ...
val dataptr = Direct (Reg 23) : ea
val dataptr' = Reg 23 : register
Comment: [dbm] Further static analysis could verify that this
  pattern would be matched, but this analysis is not done.
Status: not a bug
---------------------------------------------------------------------------
Number: 459
Title: signature matching
Keywords: 
Submitter:      Robert Thau, rst@ai.mit.edu
Date:           12/10/91
Version:        75
System:         Sparcstation 1 / SunOS 4.1.1
Severity:       
Problem:        The following two lines of admittedly questionable
		code seem to throw the SML/NJ compiler into a loop,
		madly consing with no apparent end in sight.

Code:           
	signature foosig = sig val foo: 'a -> int end;
	structure foostruct:foosig = struct fun foo x = x end;

Status: fixed in 0.80 (or earlier)
---------------------------------------------------------------------------
Number: 460
Title: signature matching
Keywords: 
Submitter:	Tsung-Min Kuo	(email : kuo@ecrc.de)
Date:		12/12/91
Version:        Version 0.75, November 11, 1991
System:         SPARCstation 1, SUNOS 4.1
Severity:	VERY severe
Problem:        Compiler blowup --- use up 24M heap
Code:
	signature A = sig val s : (unit -> 'a) -> unit end
	structure A : A = struct fun s f = f() end

Transcript:

	Standard ML of New Jersey, Version 75, November 11, 1991
	Arrays have changed; see Release Notes
	val it = () : unit
	- signature A = sig val s : (unit -> 'a) -> unit end;
	signature A = 
	  sig
	    val s : (unit -> 'a) -> unit
	  end
	- structure A : A = struct fun s f = f() end;
	
	[Increasing heap to 10003k]
	
	[Major collection... 69% used (3607244/5171504), 6790 msec]
	
	[Increasing heap to 15147k]
	
	[Major collection...
	[Increasing heap to 23187k]
	 80% used (7597900/9458020), 12920 msec]
	
	[Increasing heap to 23467k]
	
	[Major collection... 73% used (9457996/12885048), 17240 msec]
	
	[Increasing heap to 23575k]
	
	2[Major collection...
	[Increasing heap to 23647k]
	
	Warning: can't increase heap
	
	Ran out of memory

Comments: The signature was wrong. But, instead of reporting spec mismatch,
	  it keeps on doing heap allocation until runs out of memory.
	  By fixing the signature, or by avoiding signature constraint on
	  the structure definition, we can get around the bug.
	  The old version (0.66) seems working correctly on this example.

Submitter:      Francois Bourdoncle <bourdoncle@prl.dec.com>
>Date:           3/13/92
Version:        0.75
System:         Ultrix 4.2 on a DECstation 5200 (but also VAX 8600)
Problem:        compiler loops on erroneous signature matching
Code:

	signature SIG =
	  sig
	    val F : 'a -> unit
	  end
	
	structure S : SIG =
	  struct
	    fun F x = x
	  end;

Transcript:

	Standard ML of New Jersey, Version 75, November 11, 1991
	Arrays have changed; see Release Notes
	val it = () : unit
	- use "bug.sml";
	[opening bug.sml]
	
	[Increasing heap to 4058k]
	
	[Increasing heap to 7678k]
	
	[Increasing heap to 14398k]
	
	[Increasing heap to 16386k]
	
	[Major collection... 69% used (5815684/8396812), 7367 msec]
	
	[Increasing heap to 24602k]
	^C[closing bug.sml]

	Interrupt
	- ^C

Status: fixed in 0.80 (or earlier)
---------------------------------------------------------------------------
Number: 461
Title: overloading and weak polymorphism
Keywords: 
Submitter:      jont@uk.co.harlqn
Date:		12/1/91
Version:        SML of NJ version number, 0.75
System:         Sun 4/330 with SunOS 4.1.1
Severity:       minor
Problem:        Problem with weak type variables
Code:

    local
      val x = ref nil
    in
      fun define(y: string list) = x := y
    end;

Transcript:
    - use "bug461.sml";
    bug461.sml:5.3-5.17 Error: nongeneric weak type variable
      x : '0Z list ref
    [closing bug461.sml]

Comments: 0.66 accepted this quite happily. As far as I can see,
  there is no problem deducing the type of overloads

Status: fixed in 0.89
---------------------------------------------------------------------------
Number: 462
Title: location info in inexhaustive pattern warnings
Keywords: 
Submitter: Bob Harper (Robert_Harper@cs.cmu.edu)
Date: 12/4/91
Version: 0.75
Problem: 
    My inexhaustive pattern warnings come out thus these days:

    .../src/type-check.sml:0.0-0.0 Warning: match not exhaustive

    The line and column number are not 0!  The messages always have 0 for both.
Comment: Is marking turned off?
Status: fixed in 0.89
---------------------------------------------------------------------------
Number: 463
Title: unmatched datatype in signature matching
Keywords: 
Submitter : Sylvie Thiebaux  sylvie@gmd.de
Date: 07/10/91
Version SML 0.66
Severity major (critical ?)
Problem :  unmatched datatype
Code :
I cannot narrow down the cause of the problem more than I have already done.
I have got several files in which I let only the necessary things. All the
files excpeted the main file can be compliled. When I compile the main file
I get the error ``unmatched datatype literal'' at the point indicated in the
program. It is maybe a problem of a sharing constraint on this type that I have given in the file LOGIC.sml. But I have already used the LOGIC signature
in a larger programm and this sharing constraint seemed to cause no problem.

Here are all the modules involved in the error message. Please do not be
surprised about what each module contains. I need each of them but I wanted to
let in each of them only the minimal necessary code in order to make your task
easier.

(*file ELEMENT.sml*)
signature ELEMENT =
    sig
	type element
	val  put : outstream -> element -> unit 
    end

(************************************************************)

(*file EQ.sml*)
import "ELEMENT";

signature EQ =
    sig
	include ELEMENT
	val eq : element -> element -> bool
    end

(**********************************************************)

(*file SET.sml*)
import "EQ";

signature SET =
    sig
	structure Eq : EQ
        type element
	    sharing type element = Eq.element
        type set;
        val empty_set : set (* unrelated to the error *)
    end

(**********************************************************)

(*file ListSet.sml*)
import "EQ";
import "SET";

functor ListSet (Eq' :EQ)  : SET  =  
    struct 
	structure Eq = Eq'
	type element = Eq.element
	type set = element list
	val empty_set :set = []
    end

(********************************************************)

(* file ATOMS.sml *)

signature ATOMS =
    sig
	type term
	type atom
	val eq_at : atom -> atom -> bool
	val put_at : outstream -> atom -> unit
    end

(******************************************************)

(*file LOGIC.sml*)
import "SET";
import "ATOMS";

signature LOGIC =
    sig
	structure At : ATOMS

	datatype literal =
	    False 
	  | True 
	  | neg of At.atom 
	  | pos of At.atom

	 type conj_set
	 structure CS : SET
	 
	 sharing type literal = CS.element (* if you remove this sharing
constraint, the error does not exist any more. But I need this constraint
and anyway, it caused no problem whith other big programms including this
signature *)
	     and type conj_set = CS.set
  end

(************************************************************************)

(*file Logic.sml*)
import "ListSet";
import "ATOMS";
import "LOGIC";

functor Logic ( atoms : ATOMS ) : LOGIC =
    struct
	structure At = atoms

	datatype literal =
	    pos of At.atom
	  | neg of At.atom
	  | True
	  | False

	fun put_lit os (pos at) =
	    At.put_at os at
	  | put_lit os (neg at) = 
	    ((output (os,"-"));
	     (At.put_at os at))
	  | put_lit os (True) =
	    output(os,"true")
	  | put_lit os (False) =
	    output(os,"false")
    
	fun eq_lit (pos at1 :literal) (pos at2 :literal) =
	    At.eq_at at1 at2
	  | eq_lit (neg at1 :literal) (neg at2 :literal) =
	    At.eq_at at1 at2
	  | eq_lit True True =
	    true
	  | eq_lit False False =
	    true
	  | eq_lit _ _ =
	    false

	structure CS = ListSet (struct
				    type element = literal
				    val eq = eq_lit
				    val put = put_lit
				end)
	type conj_set = CS.set
    end

(*****************************************************************)

(*file LOGIC_JUSTIF.sml*)
import "LOGIC";

signature LOGIC_JUSTIF =
    sig
	structure L : LOGIC
        datatype rule = implication of L.literal list * L.literal
                      | inconsistency of L.literal list
    end

(***************************************************************)

(* file Logic_justif.sml*)
import "ATOMS";
import "Logic";
import "LOGIC_JUSTIF";


functor Logic_justif (atoms: ATOMS) : LOGIC_JUSTIF =
    struct
	structure L : LOGIC = Logic(atoms)

	        datatype rule = implication of L.literal list * L.literal
		              | inconsistency of L.literal list
    end

(****************************************************************)

(*file LOGIC_JUSTIF_AND_INIT.sml *)
import "LOGIC_JUSTIF";

signature LOGIC_JUSTIF_AND_INIT =
    sig
	structure LJ : LOGIC_JUSTIF
        val background_knowledge : LJ.rule list
    end

(****************************************************************)

(* file POSS.sml *)
import "LOGIC";

signature POSS =
    sig
	structure L : LOGIC
    end

(***************************************************)

(*file Poss.sml *)
import "LOGIC_JUSTIF_AND_INIT";
import "POSS";

functor Poss (lji : LOGIC_JUSTIF_AND_INIT) : POSS =
    struct
	structure L = lji.LJ.L
    end

(***************************************************)

(*file  NOTHING.sml*)
import "POSS";

signature NOTHING =
    sig
	structure P : POSS
    end

(***********************************)

(* file Nothing.sml*)
import "POSS";
import "NOTHING";

functor Nothing (PW:POSS) : NOTHING =
    struct
	structure P = PW
    end

(***********************************)
(* main programm  : Block.sml*)
import "Logic_justif";
import "Poss";
import "NOTHING";
(* curiously, if you remove this last import, the error message does not
appear *)

structure atoms =
    struct
	datatype term = a | b | c 
	datatype atom =
                    on of term * term
                  | ontable of term
                  | holding of term
                  | clear of term
                  | handempty
	   
	fun t2s a = "a"
	  | t2s b = "b"
	  | t2s c = "c"

	fun a2s (on(X,Y))   = "on("^(t2s X)^", "^(t2s Y)^")"
                  | a2s (ontable X) = "ontable("^(t2s X)^")"
                  | a2s (holding X) = "holding("^(t2s X)^")"
                  | a2s (clear X)   = "clear("^(t2s X)^")"
                  | a2s handempty   = "handempty"
	   
	fun put_at os (at:atom) = output(os, a2s(at))

	fun eq_at (at1:atom) (at2:atom) = at1=at2
	
    end

structure logic_justif : LOGIC_JUSTIF = Logic_justif(atoms)
open logic_justif
open L
open atoms

val back_klg = nil

structure logic_justif_and_init : LOGIC_JUSTIF_AND_INIT =
  struct
      structure LJ = logic_justif
      val background_knowledge = back_klg
  end

(******************************************)

structure poss : POSS = Poss(logic_justif_and_init)
(* this is the line where the error message appears *)

Comment: may be fixed in 0.75 -- check.

Status: fixed in 0.88
---------------------------------------------------------------------------
Number: 464
Title: defining exception as data constructor
Keywords: 
Submitter: David Tarditi
Date: 7/19/91
Version: 0.70
Severity: minor
Problem: 
  The following results in a compiler bug message in version 0.70:

  datatype d = D;
  exception e = D;

  The error message is:
  Error: Compiler bug: in makedec EXCEPTIONdec

Comment:

This is probably due to the fact that exceptions and constructors
share the same name space.  A check that the binding for the rhs of
"exception e = ..." is an exception is probably missing.

Status: fixed in 0.75
---------------------------------------------------------------------------
Number: 465
Title: opening unbound structure id in signature
Keywords: 
Submitter: David Tarditi
Date: 7/19/91
Version: 0.70
Severity: minor
Problem: 
    The compiler falls over with the exception UnboundTable if you
    try to open an undefined structure in a signature.
Code: 
  signature S =
  sig
    open T (* T is undefined *)
  end
Status: fixed in 0.75
---------------------------------------------------------------------------
Number: 466
Title: looping error message
Keywords: 
Submitter:      Matti Jokinen, moj@utu.fi
Date:		6/22/91
Version:        0.69, 0.70, possibly others
System:         probably all
Severity:       minor for an experienced user, but confusing to novices

Problem:        unterminating error message

Code:           fun f (p,q) =
		    let fun g (p,q) = #1 q orelse f (p,q)
		    in g (p, #2 q)
		end;

Transcript:	- fun f (p,q) =
		=     let fun g (p,q) = #1 q orelse f (p,q)
		=     in g (p, #2 q)
		= end;
		std_in:2.9-2.41 Error: unresolved flex record in let pattern
		  type: {1:bool,...}
		std_in:1.1-4.3 Error: unresolved flex record in let pattern
		  type: {1:bool,2:{1:bool,2:{1:bool,2:{1:bool,2:{1:bool,2:{1
		:bool,2:{1:bool,2:{1:bool,2:{1:bool,2:{1:bool,2:{1:bool,2:{1
		:bool,2:{1:bool,2:{1:bool,2:{1:bool,2:{1:bool,2:{1:bool,2:{1
		:bool,2:{1:bool,2:{1:bool,2:{1:bool,2:{1:bool,2:{1:bool,2:{1
		- - -

Comments:	Can be interrupted with ^c.
Status: fixed in 0.80
---------------------------------------------------------------------------
Number: 467
Title: missing newline in declaration echo
Keywords: 
Submitter:      Matti Jokinen (moj@utu.fi)
Date:		7/23/91
Version:        0.69, 0.70, possibly others
System:         all
Severity:       minor

Problem:        Fixity declarations are echoed without newlines.

Code:           infix L; infixr R; nonfix N;

Transcript:	- infix L; infixr R; nonfix N;
		infix Linfixr Rnonfix N-
				       ^
				       This is the next prompt.

Fix:		Add `newline()' at the end of the printFixity function
		defined in src/print/printdec.sml:

*** printdec.sml.orig   Thu Mar 14 17:50:22 1991
--- printdec.sml        Mon Jul 22 04:11:27 1991
***************
*** 215,227 ****
        and printFixity{fixity,ops} =
            (case fixity of
               NONfix => print "nonfix "
             | INfix (i,_) =>
                 (if i mod 2 = 0 then
                    print "infix "
                  else print "infixr ";
                  if i div 2 > 0 then
                    (print (i div 2);
                     print " ")
                  else ());
!            printSequence " " printSym ops)

--- 215,228 ----
        and printFixity{fixity,ops} =
            (case fixity of
               NONfix => print "nonfix "
             | INfix (i,_) =>
                 (if i mod 2 = 0 then
                    print "infix "
                  else print "infixr ";
                  if i div 2 > 0 then
                    (print (i div 2);
                     print " ")
                  else ());
!            printSequence " " printSym ops;
!            newline())

Status: fixed in 0.75
---------------------------------------------------------------------------
Number: 468
Title: extra comma in printing unit record
Keywords: 
Submitter: Thomas Yan (Cornell)
Date: 11/18/91
Version: 0.75
Severity: minor
Problem: 
  Extra comma in printing unit record:
Transcript: 
  - val {...} = ();
  std_in:2.1-2.14 Warning: binding contains no variables
          {,...} = ...
Status: fixed in 0.85
---------------------------------------------------------------------------
Number: 469
Title: infix precedence bound
Keywords: 
Submitter: Thomas Yan (Cornell)
Date: 11/18/91
Version: 0.75
Severity: minor
Problem: 
  Infix declaration allows values greater than 9:
Transcript: 
  - infix 10 +;
  infix 10 +
Status: fixed in 0.90
---------------------------------------------------------------------------
Number: 470
Title: top-level continuations
Keywords: 
Submitter:	Francis.Dupont@inria.fr
Date:		11/23/91
Version:	0.75
System:		all systems (tested on Sun4/75 running SunOS4.1.1)
Severity:	major
Problem:	the typing of toplevel continuation is incorrect
Code:		see later
Transcript:	see later
Comments:	this bug cannot be corrected because toplevel continuations
		(implied by call/cc) are not compatible with SML type system
		(see all the literature on this topics, for intance my
		PhD thesis if you can read French...)
Fix:		Easy : drop call/cc (use limited static continuations)

The code and the bug :

% sml
Standard ML of New Jersey, Version 75, November 11, 1991
Arrays have changed; see Release Notes
val it = () : unit
- datatype foo = None | Kont of int cont;
datatype  foo
con Kont : int cont -> foo
con None : foo
- val x = ref None;
val x = ref None : foo ref
- callcc (fn k => (x := Kont k; 1));
val it = 1 : int
- val y = (fn (Kont k) => k) (!x);
std_in:5.10-5.25 Warning: match not exhaustive
        Kont k => ...
val y = cont : int cont
- val f = (throw y : int -> bool);
val f = fn : int -> bool
- f 1;
val it = 1 : int

Francis.Dupont@inria.fr

PS : a variant of this bug is described in report 145 "stale top-level
continuations cause type bugs" (cf doc/bugs/masterbugs) and its status
is "fixed in 0.49" (sorry, it cannot be fixed) !

Status: fixed in 0.82 (but further investigation is warranted)
---------------------------------------------------------------------------
Number: 471
Title: allocating large arrays
Keywords: 
Submitter: Mike Crawley <mjc@abstract-hardware-ltd.co.uk>
Date: 11/26/91
Version: 0.75
Severity: serious
Problem: 
  Sometimes it will crash when allocating very large arrays.
Transcript: 
     Standard ML of New Jersey, Version 75, November 11, 1991
     Arrays have changed; see Release Notes
     val it = () : unit
     - open Array;
     open Array
     - infix 7 sub;
     infix 7 sub
     - fun Sieve n =
     let
       val A = array (n,false) ;

       fun set i di = if i < n then (update (A,i,true) ; set (i+di) di ) else () ;

       fun get 1 acc = acc
       |   get i acc = get (i-1) (if A sub i then acc else i :: acc) ;

       fun siv i = if i >= n then [] else
		   if (A sub i) = false then (set (i+i) i ; siv (i+1))
		   else siv (i+1) ;
     in
       siv 2 ; get (n-1) []
     end ;
     val Sieve = fn : int -> int list
     - Sieve 3628800;
  Segmentation fault (core dumped)

  But it works if I do it more gently.

  Standard ML of New Jersey, Version 75, November 11, 1991
  Arrays have changed; see Release Notes
  val it = () : unit
  - open Array;
  open Array
  - infix 7 sub;
  infix 7 sub
  - fun Sieve n =
  let
    val A = array (n,false) ;

    fun set i di = if i < n then (update (A,i,true) ; set (i+di) di ) else () ;

    fun get 1 acc = acc
    |   get i acc = get (i-1) (if A sub i then acc else i :: acc) ;

    fun siv i = if i >= n then [] else
		if (A sub i) = false then (set (i+i) i ; siv (i+1))
		else siv (i+1) ;
  in
    siv 2 ; get (n-1) []
  end ;
  val Sieve = fn : int -> int list
  - Sieve 1000000;

  [Increasing heap to 2952k]

  [Increasing heap to 5792k]

  [Increasing heap to 8192k]

  [Major collection... 63% used (412372/652688), 250 msec]

  [Increasing heap to 12544k]
  val it = [2,3,5,7,11,13,17,19,23,29,31,37,...] : int list
  - Sieve 3628800;

  [Major collection... 25% used (1354396/5356616), 880 msec]

  [Increasing heap to 14944k]

  [Major collection... 99% used (1354396/1354396), 870 msec]

  [Increasing heap to 24408k]

  [Major collection... 99% used (1354396/1354396), 860 msec]

  [Increasing heap to 38600k]

  [Increasing heap to 42544k]
  val it = [2,3,5,7,11,13,17,19,23,29,31,37,...] : int list
  - 
Comments:
  This occurs in
     Standard ML of New Jersey, Version 75, November 11, 1991
     Standard ML of New Jersey, Version 0.73, 10 September 1991
     Standard ML of New Jersey, Version 0.66, 15 September 1990
  so I think it is the memory allocation rather than the new Array structure.
Status: fixed in 0.84
---------------------------------------------------------------------------
Number: 472
Title: growing heap
Keywords: 
Submitter: Simon Finn <simon@abstract-hardware-ltd.co.uk>
Date: 11/26/91
Version: 0.75
System: ?
Severity: serious 
Problem: 
  SML/NJ version 0.75 seems to have a problem when asked to grow
  the heap by a large factor.
Transcript: 
 this works:
  Perky%  /ml/njml/mlsave.75/src/sml
  Standard ML of New Jersey, Version 75, November 11, 1991
  Arrays have changed; see Release Notes
  val it = () : unit
  - val y = Array.array (1000000,true);

  [Increasing heap to 4020k]

  [Increasing heap to 8192k]

  [Major collection... 98% used (409232/414048), 260 msec]

  [Increasing heap to 12884k]
  val y = prim? : bool array
  - val x = Array.array (2000000,true);

  [Increasing heap to 16636k]

  [Major collection... 99% used (4409484/4411876), 1770 msec]

  [Increasing heap to 31412k]
  val x = prim? : bool array

 but this doesn't:

  - Perky% !!
  /ml/njml/mlsave.75/src/sml
  Standard ML of New Jersey, Version 75, November 11, 1991
  Arrays have changed; see Release Notes
  val it = () : unit
  - val x = Array.array (2000000,true);
  Segmentation fault (core dumped)
  Perky% 

Status: fixed in 0.84
---------------------------------------------------------------------------
Number: 473
Title: inadequate error message
Keywords: 
Submitter: George Otto (ptah!otto)
Date: 11/27/91
Version: 0.75?
Severity: minor
Problem: 
  I put some ML datatype definitions into a file and then brought them into ML
  using the command

	  use "file";

  I got back the error message "duplicate constructor" with no other
  information.  Couldn't this be more helpful and mention the name of the
  constructor it is reporting about?
Status: fixed in 0.91 (dbm)
---------------------------------------------------------------------------
Number: 474
Title: compiler bug: patType -- unexpected pattern
Keywords: 
Submitter: John Reppy
Date: 12/6/91
Version: 0.75
Severity: minor
Problem: 
  Compiler bug: patType -- unexpected pattern
Code: 
    (* extract the draw_cmd, id and depth of a drawable *)
      fun infoOfDrawable (DRAWABLE{draw_cmd, DWIN w}) = let
	    val WIN{id, scr_depth=SCRDEPTH{depth, ...}, ...} = w
	    in
	      {draw_cmd=draw_cmd, id=id, depth=depth}
	    end
	| infoOfDrawable (DRAWABLE{draw_cmd, DPM pm}) = let
	    val PM{id, scr_depth=SCRDEPTH{depth, ...}, ...} = pm
	    in
	      {draw_cmd=draw_cmd, id=id, depth=depth}
	    end
Transcript: 
  window/draw.sml:16.51 Error: syntax error: inserting AS
  window/draw.sml:21.43-21.44 Error: syntax error: inserting AS
  Error: Compiler bug: patType -- unexpected pattern
Comments: couldn't isolate small example (same as #515)
Status: fixed in 0.83
---------------------------------------------------------------------------
Number: 475
Title: LOOKUP exception from mllex (see also 510, 516)
Keywords: 
Submitter:      Markus Freericks, mfx@cs.tu-berlin.de
Date:		12/12/91
Version:        Standard ML of New Jersey, Version 75, November 11, 1991
System:         Sparc
Severity:       quite minor		
Problem:        
When I use a regular expression that isn't defined, I get an unhelpful
exception LOOKUP. This exception is not mentioned in lexgen.doc, and
there is no indication as to where the problem occurs in the input
file.
Code:           

(* bug *)
%%
%%
{xxx}	=> {()};

Transcript:

	mfx@marx [77]% sml-lex bug
	? sml-lex: uncaught exception LOOKUP
or

- use "lexgen.sml";
[opening lexgen.sml]
lexgen.sml:1127.5-1131.57 Warning: match not exhaustive
        (true,129) => ...
        (true,256) => ...
        (false,129) => ...
        (false,256) => ...
lexgen.sml:876.2-895.10 Warning: match not exhaustive
        (nil,nil) => ...
        (a :: a',b :: b') => ...
lexgen.sml:854.19-855.48 Warning: match not exhaustive
        1 => ...
        2 => ...
        3 => ...
lexgen.sml:813.9-813.55 Warning: match not exhaustive
        (tl,el) :: r => ...
functor RedBlack : <sig>
signature LEXGEN = 
  sig
    val lexGen : string -> unit
  end
structure LexGen : LEXGEN
[closing lexgen.sml]
val it = () : unit

- LexGen.lexGen "bug";

uncaught exception LOOKUP

Comments:
Being what could be called a 'naive user', I first thought my
installation of SML and/or lexgen.sml to be in error. The warnings
encountered when loading lexgen.sml added to this impression.

Fix:
A change to the doc should be enough; the error in the input file is
easy enough to find when one knows what to search for.
Status: fixed in 0.91 (Tarditi)
---------------------------------------------------------------------------
Number: 476
Title: sml-lex
Keywords: 
Submitter: Denys Duchier <dduchier@csi.UOttawa.CA>
Date: 12/11/91
Version: 0.75
Severity: minor
Problem: 
  sml-lex (with SML V75) produces a lexer that contains D and T states
  when I use the special character $.  Here is the source:
Code: 

    datatype lexresult = EOF;
    fun eof () = EOF;
    %%
    %%
    ";".*$	=> (lex());

Comments: the rule is meant to parse a lisp-style comment.
  Andrew sez:  I'm not sure that this is really a bug.  Perhaps the
  documentation needs to be changed?
Status: fixed  in 0.91 (Tarditi)
---------------------------------------------------------------------------
Number: 477
Title: duplicate specifications through include
Keywords: 
Submitter: Nick Rothwell
Date: 10/21/91
Version: 0.73
Severity: minor
Problem: 
    I enclose a short-ish (40 line) program. It compiles under poplog and one
    version of poly. It fails under another version of poly and with different
    errors under two versions of SML/NJ. By my reckoning, the program is legal
    SML.
Code: 
  signature MONO_SET =
    sig
      type Element
      type Set
      type T sharing type T = Set
    end;

  functor MonoSet(type T): MONO_SET =
    struct
      abstype Set = Set of T list
      with
	type Element = T
	type T = Set
      end
    end;

  signature INPUT_VAR =
    sig
      type InputVar
      type InputVarSet

      include MONO_SET sharing type Element = InputVar
			   and type Set = InputVarSet

      type T sharing type T = InputVar
    end;

  functor InputVar(): INPUT_VAR =
    struct
      datatype InputVar = INPUT_VAR of string

      local
	structure S = MonoSet(type T = InputVar)
      in
	open S
	type InputVarSet = Set
      end

      type T = InputVar
    end;

Transcript: 
  X.sml:25.10 Error: duplicate specifications for type constructor T in signature
Comments: a deliberate divergence from the Definition.
Status: not a bug
----------------------------------------------------------------------
Number: 478
Title: order of type definitions in withtype clause
Keywords: 
Submitter: Andrew Appel
Date: 10/11/91
Version: 0.73
Severity: minor
Problem: 
  Type definitions in withtype clause have to be ordered properly.
Code: 
    datatype foo = T 
      withtype a = b and b = foo
Comments:
  I think this is correct.  Have to check Definition.
Status: not a bug
----------------------------------------------------------------------
Number: 479
Title: Boxity exception in vector_n
Keywords: 
Submitter: Andrew Koenig
Date: 10/22/91
Version: ?
Severity: major
Problem: 
  Applying vector_n with index out of bounds yields Boxity exception.
Transcript: 
    - open Vector;
    open Vector
    - infix 9 sub;
    infix 9 sub
    - val x = vector_n(10,[1,2,3]);
    val x = - : int vector
    - length(x);
    val it = 10 : int
    - x sub 0;
    val it = 1 : int
    - x sub 1;
    val it = 2 : int
    - x sub 2;
    val it = 3 : int
    - x sub 3;
    val it = 8 : int
    - x sub 4;
    val it = 
    uncaught exception Boxity
Comments:
  vector_n was not supposed to be exported.
Status: fixed in 0.75
----------------------------------------------------------------------
Number: 480
Title: Exit status of makeml is 1.
Keywords: 
Submitter: David Tarditi
Date: 10/23/91
Version: 0.75?
Severity: minor
Problem: 
    makeml almost always returns an exit status of 1, which
    indicates failure.   This is because as a shell program it
    returns the value of its last command, which is an if-statement
    that almost always "fails" (the value of the if-statement is
    the last simple command that it executes, which is a test that
    fails; there is no "else" clause to execute).

    This creates problems for me when I use a makefile that invokes
    makeml to build sml images.  Could you make the last statement
    in makeml "exit 0" ?
Comments:
Status: fixed in 0.89
----------------------------------------------------------------------
Number: 481
Title: redeclared constructors
Keywords: signatures, multiple specifications
Submitter: Mike Crawley <mjc@abstract-hardware-ltd.co.uk>
Date: 10/28/91
Version: 0.73
Severity: minor
Problem: 
    SML/NJ 0.73 does not accept the following valid ML program
Code: 
    signature S = sig
      datatype a = A | B of string ;
      datatype b = B | C ;
    end ;

    functor F(S:S) =
    struct
      open S ;

      fun matchA A = true
      |   matchA _ = false ;

      fun matchB B = true
      |   matchB _ = false ;

      fun matchC C = true
      |   matchC _ = false ;
    end ;

    structure S = F ( datatype a = A | B of string ;
		      datatype b = B | C ) ;

Owner: dbm
Status: not a bug (not allowed in SML 96)
----------------------------------------------------------------------
Number: 482
Title: "constant" unary type abbreviations in signature matching
Keywords: 
Submitter: Mike Crawley <mjc@abstract-hardware-ltd.co.uk>
Date: 10/28/91
Version: 0.73
Severity: significant
Problem: 
   Poly/ML allows this; SML/NJ 0.73 doesn't
   It all depends whether or not you expand the type-abbreviation t
   when you match the datatype d.
Code: 
    signature A =
    sig
      eqtype 'a t
      datatype d = C | D of int t
    end;

    structure Z =
    struct
      type 'a t = bool
      datatype d = C | D of bool t
    end;

    structure X : A = Z;
Status: fixed in 0.80
----------------------------------------------------------------------
Number: 483
Title: lexgen compilation blowup
Keywords: 
Submitter:	Lie Ma, ma@cs.pdx.edu
Date:		10/29/91
Version:	SML Ver.0.66
System:		Sun Sparc
Code:		lexgen.sml Ver. 1.3, Dec'89
Encl:		typescript
Problem:	
	
	I'm using lexgen to write a lexer for a formal specification language.
	According to the manual, I should use lexgen.sml in the following way:

	quote: 
		Running ML-Lex
		Use "lexgen.sml"; this will create a structre LexGen. 
		The function LexGen.lexGen creates a program for a
		lexer from an input specification. It takes a string
		argument -- the name of the file containing the input
		spacification. The output file name is determined by
		appending ".sml" to the input file name.
	end{quote}

	I got the extremly poor performance when I tried to use "lexgen.sml".
	I tried on two Suns, both taking appr. 25 to 28 minutes to evaluate
	"lexgen.sml". The maximum heap was about 16 MB. The process was so 
	huge that the system speeded donw and I had to kill it in most cases.
	And once other user even could not run latex within emacs.

	I want to know whether it is usual. If not, it's caused by ML or 
	"lexgen.sml"?

	Thank you to your attention to this. Your prompt reply will be 
	appreciated.
Status: fixed in 0.89
----------------------------------------------------------------------
Number: 484
Title: interrupt is buggy (same as 511, 518)
Keywords: 
Submitter: Mike Crawley
Date: 10/29/91
Version: 0.73
System: Sparc/SunOS
Severity: major
Problem: 
  I have been able to repeat the following
  bug a number of times. Pressing ^C to interrupt
  sml while it is busy can sometimes crash it.
  The saved image I was using was 10MB at the time.
  
  ^C
  SIGEMT not related to gc (bogus test: 0x9de3bfc0 @ 0x9dd8)
  
Transcript: 
Comments:
    This is a very mysterious bug that has been around for a while.  The
    "0x9de3bfc0 @ 0x9dd8" means that the signal handler received a SIGEMT
    signal with the PC = 0x9dd8 and the instruction at that address being
    "save %sp,-0x40,%sp."  Under my reading of the documentation, this
    should never occur in SunOS.  The address 0x9dd8 is interesting, since
    it is the address of an assembly routine used to force a GC trap
    after a signal (such as ^C), but I don't understand how the sigcontext
    program counter gets that value.  [John Reppy]
Status: fixed in 109.21 (probably)
----------------------------------------------------------------------
Number: 485
Title: structure manipulation bombs
Keywords: 
Submitter:      Tim Freeman <tsf@cs.cmu.edu>
Date:		10/31/91
Version:        0.74
System:         Sun 4 running some version of Mach
Severity:       minor
Problem:        With some manipulations of structures, raising
		unhandled exceptions causes SML to bomb.
Code:           bug3.sml contains:
		structure Util = 
		    struct
			exception Bug of string
		    end
		
		structure InstProto = 
		struct
		    structure U = Util
		    structure S = struct end 
		end 
		
		open InstProto
		;
		raise U.Bug "hi"

Transcript:     % sml
		Standard ML of New Jersey, Version 0.74, 10 October, 1991
		Prerelease version.  Arrays have changed; see doc/NEWS
		val it = () : unit
		- use "bug3.sml";
		[opening bug3.sml]
		structure Util : 
		  sig
		    exception Bug of string
		  end
		structure InstProto : 
		  sig
		    structure S : ...
		    structure U : ...
		  end
		open InstProto
		SIGILL code 0x7
		% 				
Comments:	Earlier during the process of narrowing down this bug,
		it was saying 

			uncaught exception random binary garbage

		(except you have to imagine the string "random binary
		garbage" replaced by random binary garbage) instead of
		getting the SIGILL trap. 

Status: fixed in 0.84
----------------------------------------------------------------------
Number: 486
Title: Regbind exception (same as bug 380?)
Keywords: 
Submitter:      jont@harlqn.co.uk
Date:           31/10/91
Version:        SML of NJ version number, 0.66
System:         Sun 4/330 with SunOS 4.1.1
Severity:       critical
Problem:        The code generation phase blows up with an uncaught
		exception Regbind
Code:           
(* _testreals.sml the functor (used to be) *)
(*
Copyright (c) 1991 Harlequin Ltd.
*)

  fun div2 _ =
    let
      val new_y = if 0 mod 2 = 0 then "0" else chr(ord "0" + 1)
    in
      div2 []
    end

Transcript:
sml66
Standard ML of New Jersey, Version 0.66, 15 September 1990
val it = () : unit
- use"../main/_testreals.sml";
[opening ../main/_testreals.sml]
[closing ../main/_testreals.sml]

uncaught exception Regbind

Comments: This is the second time I have encountered this problem. The
first time I was unable to produce a small example, and it later went
away for reasons which were never clear. However, this time it cropped
up in a functor which was only 80 lines at the time, and I was able to
whittle it down to the above rather useless function.

Probably same as bug #380.
Status: fixed in 0.84
----------------------------------------------------------------------
Number: 487
Title: clumsy memory exhaustion
Keywords: 
Submitter: Andy Koenig
Date: 11/7/91
Version: 0.74
System: Sparc
Severity: minor 
Problem: 
   SML-NJ is not very nice about handling memory exhaustion.
Transcript: 

	[boojum] sml
	Standard ML of New Jersey, Version 0.74, 10 October, 1991
	Prerelease version.  Arrays have changed; see doc/NEWS
	val it = () : unit
	- fun f x = f(0::x);
	val f = fn : int list -> 'a
	- f nil;

	[Increasing heap to 3164k]

	[Increasing heap to 4452k]

	[Increasing heap to 5456k]

	[Major collection...
	[Increasing heap to 8192k]
	 76% used (3427160/4508104), 2610 msec]

	[Increasing heap to 13192k]

	[Major collection... 49% used (4497848/8999168), 4600 msec]

	[Increasing heap to 26380k]

	[Major collection... 49% used (8999168/18002072), 9250 msec]

	[Increasing heap to 27204k]

	[Major collection...
	[Increasing heap to 27620k]

	[Increasing heap to 27776k]

	[Increasing heap to 27860k]

	[Increasing heap to 27880k]

	Warning: can't increase heap

	Ran out of memory[boojum] 
Comments:

Identical to bug 454.

While I do ultimately expect some kind of drastic termination,
I do **NOT** expect to be unceremoniously dumped out of ML back
into the Shell.  A more reasonable strategy might be to preallocate
a chunk of memory to be used as secondary storage while recovering
from exhaustion of primary storage.  That, at least, would allow
for a return to top level and associated garbage collection, which,
in many cases, would allow interactive execution to resume.

Incidentally, this example was run on a Sparcstation with 64
megabytes of physical memory and no limit on process size
that I know of.  I don't know why it gave up the ghost at
28 megabytes -- do you?

Owner: 
Status: open
----------------------------------------------------------------------
Number: 488
Title: wrong types in pervasives
Keywords: 
Submitter: Thomas Yan
Date: 8/21/91
Version: 0.71
Severity: minor
Problem: 
  bugs in the pervasive environment
Transcript: 
  Standard ML of New Jersey, Version 0.71, 23 July 1991
  val it = () : unit
  - Array.tabulate;
  val it = fn : 'a * (int -> '1b) -> '1b array
  - String.chr;
  val it = fn : int -> 'a
  - 
Status: fixed in 0.75
----------------------------------------------------------------------
Number: 489
Title: exportFn image size too large
Keywords: 
Submitter: Andy Koenig
Date: 11/17/91
Version: 0.75
System: Sparc
Severity: significant
Problem: 
    On a Sparc, here's the text and data space used by the executable
    produced by the following program (with an ML build with noshare):

	    exportFn ("a.out", fn _ => print "Hello world\n");

    Version		text	data

    0.66		57344	188416
    pre-74		81920	425984
    75			81920	294912

    Evidently some of the memory leaks in 0.66 have been fixed but not all.

    Anoither example from John Reppy:
    (sml-export was made with the -pervshare option)

    <jhr@bat> sml-export
    Standard ML of New Jersey, Version 0.89, September 4, 1992
    val it = () : unit
    - exportFn("foo", fn _ => ());

    [Major collection... 25% used (842428/3366736), 430 msec]

    [Major collection... 66% used (560264/844136), 310 msec]
    <jhr@bat> size foo
    text    data    bss     dec     hex
    241664  614400  0       856064  d1000
    <jhr@bat> size sml-export
    text    data    bss     dec     hex
    241664  3416064 0       3657728 37d000

Fix:
  Environment refs (pervasiveEnvRef, topLevelEnvRef) were added to
  Hooks and cleared on export.  Changed files boot/perv.sml and
  boot/system.sig.
Status: fixed in 0.94 (0.93c awa,dbm)
----------------------------------------------------------------------
Number: 490
Title: function has bad type in pervasives
Keywords: 
Submitter: Lal Geoge
Date: 11/20/91
Version: 0.75
Severity: significant
Problem: 
  ceiling has wrong type
Transcript: 
    Standard ML of New Jersey, Version 75, November 11, 1991
    Arrays have changed; see Release Notes
    - ceiling;
    val it = fn : real -> 'a
    -
Status: fixed in 0.76
----------------------------------------------------------------------
Number: 491
Title: memory leak
Keywords: 
Submitter:      Nevin Heintze (nch@cs.cmu.edu)
Date:  		11/20/91
Version:        0.75
System:         sparc1, pmax, sun3
		Mach 2.6 #5.1(CS8f): Wed Sep 11 14:39:14 EDT 1991; CS8/STD+WS
Severity:       major
Problem:        garbage collection when rebuilding structures
		(stuff in old structures does not seem to be reclaimed).
Code:           

signature MEM_HOG =
  sig
    val X : int Array.array
  end

functor Mem_hog() : MEM_HOG =
struct
    val X = Array.array(200000, 42) 
  end

structure Mem_hog : MEM_HOG = Mem_hog();
open Mem_hog;

structure Mem_hog : MEM_HOG = Mem_hog();
open Mem_hog;

(* etc...  (Following transcript uses 8 functor applications) *)

Transcript:   

Script started on Wed Nov 20 13:54:15 1991
[alonzo] % sml
Standard ML of New Jersey, Version 75, November 11, 1991
Arrays have changed; see Release Notes
val it = () : unit
- use "mem.sml";
[opening mem.sml]

[Increasing heap to 3174k]
signature MEM_HOG = 
  sig
    val X : int array
  end
functor Mem_hog : <sig>
structure Mem_hog : MEM_HOG
open Mem_hog

[Increasing heap to 3990k]
structure Mem_hog : MEM_HOG

[Increasing heap to 4094k]
open Mem_hog
structure Mem_hog : MEM_HOG
open Mem_hog

[Major collection...
[Increasing heap to 6486k]
 98% used (2814944/2866068), 1930 msec]

[Increasing heap to 10022k]
structure Mem_hog : MEM_HOG
open Mem_hog
structure Mem_hog : MEM_HOG
open Mem_hog
structure Mem_hog : MEM_HOG
open Mem_hog
structure Mem_hog : MEM_HOG

[Major collection...
[Increasing heap to 17126k]
 73% used (4412384/6025784), 3670 msec]

[Increasing heap to 17646k]
open Mem_hog
structure Mem_hog : MEM_HOG
open Mem_hog
[closing mem.sml]
val it = () : unit
-
[alonzo] % exit
script done on Wed Nov 20 13:54:43 1991

Comments:
  I have been running into this problem for a while now in 
  some program analysis implementation work, but was not sure where
  the problem was.  After about 3-4 rebuilds of my system I usually
  have to start another core image.  

  The general problem occurs on sparc, sun4 and pmax machines;
  the specific code given above has been tried on a sparc (24MB) and a
  pmax (64MB?).  If the "open Mem_hog" is removed, then the problem goes
  away.  The problem is not specific to arrays; for example if X is
  bound to a list of a couple of thousand elements instead of an array,
  then similar behaviour occurs.
Status: fixed in 0.89
----------------------------------------------------------------------
Number: 492
Title: compiler bug from sharing
Keywords: 
Submitter: David Tarditi
Date: 7/19/91
Version: 0.70
Severity: major
Problem: 
    This code causes a compiler bug in version 0.70.  It should be
    an interesting test case in the future.
Code: 
(* This code shows that we'll need to augment structure instantiation
   arrays during functor abstraction to include structures which are
   not in the signature, but which have views that are in the
   signature.
*)

signature S0 = sig
	         type u
	       end

signature S1 = sig
	         type t
	         val v : t
	       end

(* define a structure A, but export only views of A *)

functor F1() : sig
	         structure B : S0
	         structure C : S1
	       end =
   struct
	structure A = struct
	                  datatype u = U
	                  datatype t = T
	                  val v = T
	              end
        structure B : S0 = A
	structure C : S1 = A
   end

structure D = F1()

(* the definitional sharing constraint implies that C.t = D.C.t,
   but we won't know this unless we keep the origin of D.B around.*)

functor F2(A : sig 
	        structure C : S1
	        sharing D.B = C
	       end) : sig
	 	         val v : A.C.t
	              end =
   struct
	val v = D.C.v
   end
Status: fixed in 0.84
----------------------------------------------------------------------
Number: 493
Title: Compiler bugs from bad include specs
Keywords: 
Submitter: Bruce Esrig
Date: 7/19/91
Version: ?
Severity: major
Problem: 
  Compiler bug from include specs
Code: 
(* Sigs.sml -- experiment with signatures and sharing *)

(* this is accepted *)
signature X' = sig datatype 'a Opt = None | Some of 'a end
signature Y' = sig datatype 'a Opt = None | Some of 'a end
signature Z' = sig include X' include Y' end;

(* this fails *)
signature X' = sig datatype 'a Opt = None | Some of 'a end
signature Y' = sig include X' end

(* signature Z' = sig include X' include Y' end *)
(* std_in:0.0 Compiler Bug: Signs.abstractSig.abstractType 2 *)

(* signature W' = sig include X' include Y' sharing type X'.Opt = Y'.Opt end *)
(* std_in:0.0 Compiler Bug: Signs.abstractSig.abstractType 2 *)

signature X' = sig type opt end
signature Y' = sig type opt end
(* signature Z' = sig include X' include Y' sharing type X'.opt = Y'.opt end *)
(* std_in:2.20-2.70 Error: unbound structure id in sharing specification: X' *)


(* How do I build a signature which brings a shared type to top level? *)

signature Z' =
    sig structure X : X' structure Y : Y'
	sharing type X.opt = Y.opt
	open X
    end

structure Z : Z' =
    struct
	structure X = struct type opt = int end
	structure Y = struct type opt = int end
	open X
    end;
(* structure Z :
  sig
    structure X : sig...end
    structure Y : sig...end
  end *)

(* 5 : Z.opt; *)
(* std_in:10.5-10.9 Error: unbound type in structure: opt *)
Status: fixed in 0.84
----------------------------------------------------------------------
Number: 494
Title: bogus gc message
Keywords: 
Submitter: Bob Harper
Date: 12/16/91
Version: 0.75
Severity: minor
Problem: 
  negative number in "[Increasing heap to -12217k]" message
Transcript: 
    [reading .../front/printback.sml]

    [Major collection...
    [Increasing heap to 8110k]

    [Increasing heap to 7942k]

    [Increasing heap to 7438k]

    [Increasing heap to 5926k]

    [Increasing heap to 1390k]
    smlsg: could not sbrk, return = 1

    [Increasing heap to -12217k]				*** NB
     48% used (2767236/5647472), 2570 msec]

    [Increasing heap to 8270k]
    [writing .../.@sys/printback.sml.bin... done]
    [closing .../front/printback.sml]

Status: obsolete
--------------------------------------------------------------------
Number: 495
Title: inaccurate emacs info file
Keywords: 
Submitter:      dan@math.uiuc.edu
Date:		12/26/91
Version:        75
Severity:       minor
Problem:        

	From the IO node in the emacs info file "sml"

	    val execute : string -> instream * outstream

	From the program

	- execute;
	val it = fn : string * string list -> instream * outstream

Fix: edit the file "sml" to give the correct declaration for "execute"
Status: fixed in 0.76 (in /usr/local/sml/75/lib/emacs/info/sml)
----------------------------------------------------------------------
Number: 496
Title: incorrect defn of dec in fastlib
Keywords: 
Submitter:      Stephen Adams,  S.R.Adams@ecs.soton.ac.uk
Date:		1/3/92
Version:        0.75
Severity:       curiosity
Problem:        Curious code in compiler source

I have been looking in the compiler source and I discovered
a small bug:
Code:
(* cpsopt.sml
 *
 * Copyright 1989 by AT&T Bell Laboratories
 *)
functor CPSopt(val maxfree : int) :
        sig val reduce : CPS.function * System.Unsafe.object option * bool
                                        -> CPS.function
        end =
struct

structure Fastlib = struct

structure Ref = 
  struct
    open Ref
    fun inc r = r := !r + 1
    fun dec r = r := !r + 1		(* this is the worrying bit!*)
  end

Comment:
  dec is used but only in the function `unescapeargs'.  I
  guess that it should be fixed before it causes any grief.
Status: fixed in 0.75
----------------------------------------------------------------------
Number: 497
Title: ML-Yacc doesn't open Array
Keywords: 
Submitter:	Lie Ma, ma@cs.pdx.edu
Date:		12/26/91
Version:	SML Ver.77
System:		SUN Sparc
Code:		base.sml
Encl:		typescript
Problem:

		Error found when loading base.sml,
		while no problem using SML Ver.66.

		Or, is there new version of smlyacc
		corporated with the new version of SML?

---------------------- Typescript ----------------------

Script started on Thu Dec 26 22:45:01 1991
warning: could not update utmp entry
antares% cat makepaqrser.sml" ";
Unmatched ".
antares% cat makeparser.sml
(* ------------------------ FILE: makeparser.sml ----------------------------
   Author: Lie Ma						12/10/1991
   Usage:  Call the files "spec.grm.sig", "spec.grm.sml" (generated by 
	   "smlyacc.sml" according to "spec.grm") and "spec.lex.sml" 
	   (gnerated by "lexgen.sml" according to "spec.lex"). Then use
	   structure "SpecLrVals", "SpecLex" and "SpecParser" to generate 
	   the parser.

   Call:   spec.grm.sig, spec.grm.sml, spec.lex.sml
   Input:  nothing
   Output: parser
   -------------------------------------------------------------------------- *)

use "YACC/base.sml";	(* laod the common modules 	*)
use "spec.grm.sig";	(* load grammar signature file 	*)
use "spec.lex.sml";	(* load lexer program file 	*)
use "spec.grm.sml";	(* load grammar program file 	*)


(* --------- define structures ------------ *)

structure SpecLrVals =
	SpecLrValsFun(structure Token = LrParser.Token);
structure SpecLex = 
	SpecLexFun(structure Tokens =
		SpecLrVals.Tokens);
structure SpecParser =
	Join(structure ParserData = SpecLrVals.ParserData
		structure Lex=SpecLex
		structure LrParser=LrParser);


(* ----------- function parse to read file and parse it -------------- *)

val parse = fn s =>
  let val dev = open_in s
      val stream = SpecParser.makeLexer(fn i => input(dev,i))
      val _ = SpecLex.UserDeclarations.pos:=1
      val error = fn(e,i: int,_) => output(std_out, s ^ "," ^ " line "^
				    (makestring i) ^ ", Error: " ^ e ^ "\n")
  in SpecParser.parse(30,stream,error,()) before close_in dev
  end

val keybd = fn () =>
  let val dev = std_in
      val stream = SpecParser.makeLexer (fn i => input_line dev)
      val _ = SpecLex.UserDeclarations.pos:=1
      val error = fn(e,i: int,_) => output(std_out, "std_in, line "^
				    (makestring i) ^ ", Error: " ^ e ^ "\n")
  in SpecParser.parse(0,stream,error,()) 
  end
antares% sml
Standard ML of New Jersey, Version 75, November 11, 1991
Arrays have changed; see Release Notes
val it = () : unit
- " use "makeparser.sml";
[opening makeparser.sml]
[opening YACC/base.sml]
signature STREAM = 
  sig
    type 'a stream
    val streamify : (unit -> '1a) -> '1a stream
    val cons : '1a * '1a stream -> '1a stream
    val get : '1a stream -> '1a * '1a stream
  end
signature LR_TABLE = 
  sig
    datatype state
      con STATE : int -> state
    datatype term
      con T : int -> term
    datatype nonterm
      con NT : int -> nonterm
    datatype action
      con ACCEPT : action
      con ERROR : action
      con REDUCE : int -> action
      con SHIFT : state -> action
    type table
    val numStates : table -> int
    val describeActions : table -> state -> (term * action) list * action
    val describeGoto : table -> state -> (nonterm * state) list
    val action : table -> state * term -> action
    val goto : table -> state * nonterm -> state
    val initialState : table -> state
    exception Goto of state * nonterm
    val mkLrTable : {actions:((term * action) list * action) list,gotos:(nonterm * state) list list,initialState:state,numStates:int} -> table
  end
signature TOKEN = 
  sig
    structure LrTable : ...
    datatype ('a,'b) token
      con TOKEN : LrTable.term * ('a * 'b * 'b) -> ('a,'b) token
    val sameToken : ('a,'b) token * ('a,'b) token -> bool
  end
signature LR_PARSER = 
  sig
    structure Stream : ...
    structure LrTable : ...
    structure Token : ...
    exception ParseError
    val parse : {arg:'a,ec:{error:string * '1c * '1c -> unit,errtermvalue:LrTable.term -> '1b,is_keyword:LrTable.term -> bool,noShift:LrTable.term -> bool,preferred_insert:LrTable.term -> bool,preferred_subst:LrTable.term -> LrTable.term list,showTerminal> :LrTable.term -> string,terms:LrTable.term list},lexer:('1b,'1c) Token.token Stream.stream,lookahead:int,saction:int * '1c * (LrTable.state * ('1b * '1c * '1c)) list * 'a -> LrTable.nonterm * ('1b * '1c * '1c) * (LrTable.state * ('1b * '1c * '1c)) list,ta> ble:LrTable.table,void:'1b} -> '1b * ('1b,'1c) Token.token Stream.stream
    sharing Token.LrTable = LrTable
  end
signature LEXER = 
  sig
    structure UserDeclarations : ...
    val makeLexer : (int -> string) -> unit -> (UserDeclarations.svalue,UserDeclarations.pos) UserDeclarations.token
  end
signature ARG_LEXER = 
  sig
    structure UserDeclarations : ...
    val makeLexer : (int -> string) -> UserDeclarations.arg -> unit -> (UserDeclarations.svalue,UserDeclarations.pos) UserDeclarations.token
  end
signature PARSER_DATA = 
  sig
    type pos
    type svalue
    type arg
    type result
    structure LrTable : ...
    structure Token : ...
    structure Actions : ...
    structure EC : ...
    val table : LrTable.table
    sharing LrTable = Token.LrTable
  end
signature PARSER = 
  sig
    structure Token : ...
    structure Stream : ...
    exception ParseError
    type pos
    type result
    type arg
    type svalue
    val makeLexer : (int -> string) -> (svalue,pos) Token.token Stream.stream
    val parse : int * (svalue,pos) Token.token Stream.stream * (string * pos * pos -> unit) * arg -> result * (svalue,pos) Token.token Stream.stream
    val sameToken : (svalue,pos) Token.token * (svalue,pos) Token.token -> bool
  end
signature ARG_PARSER = 
  sig
    structure Token : ...
    structure Stream : ...
    exception ParseError
    type arg
    type lexarg
    type pos
    type result
    type svalue
    val makeLexer : (int -> string) -> lexarg -> (svalue,pos) Token.token Stream.stream
    val parse : int * (svalue,pos) Token.token Stream.stream * (string * pos * pos -> unit) * arg -> result * (svalue,pos) Token.token Stream.stream
    val sameToken : (svalue,pos) Token.token * (svalue,pos) Token.token -> bool
  end
structure Stream : STREAM
YACC/base.sml:340.14-340.16 Error: unbound variable or constructor sub
YACC/base.sml:342.10-342.25 Error: operator and operand don't agree (tycon mismatch)
  operator domain: 'Z array
  operand:         error -> int -> 'Y
  in expression:
    length a
YACC/base.sml:342.26 Error: overloaded variable "-" cannot be resolved
YACC/base.sml:395.36-395.38 Error: unbound variable or constructor sub
YACC/base.sml:395.28-395.45 Error: operator is not a function
  operator: (int array * int) array
  in expression:
    action bogus
YACC/base.sml:402.26-402.28 Error: unbound variable or constructor sub
YACC/base.sml:402.20-402.35 Error: operator is not a function
  operator: int array array
  in expression:
    goto bogus
YACC/base.sml:409.45-409.47 Error: unbound variable or constructor sub
YACC/base.sml:421.53-421.55 Error: unbound variable or constructor sub
YACC/base.sml:418.27-418.48 Error: operator and operand don't agree (tycon mismatch)
  operator domain: 'Z array
  operand:         error -> int -> int
  in expression:
    length row
YACC/base.sml:421.40-421.62 Error: operator is not a function
  operator: (int array * int) array
  in expression:
    action bogus
YACC/base.sml:418.46 Error: overloaded variable "-" cannot be resolved
YACC/base.sml:427.29-427.31 Error: unbound variable or constructor sub
YACC/base.sml:431.49-431.51 Error: unbound variable or constructor sub
YACC/base.sml:427.14-427.37 Error: operator is not a function
  operator: int array array
  in expression:
    goto bogus
YACC/base.sml:447.5-447.15 Error: unbound variable or constructor arrayoflist
YACC/base.sml:449.5-449.15 Error: unbound variable or constructor arrayoflist
YACC/base.sml:450.17-450.27 Error: unbound variable or constructor arrayoflist
YACC/base.sml:453.14-453.24 Error: unbound variable or constructor arrayoflist
[closing YACC/base.sml]
[closing makeparser.sml]
- ^Dantares% ^D
script done on Thu Dec 26 22:46:17 1991
Status: fixed in 0.84
----------------------------------------------------------------------
Number: 498
Title: bad function type in perv.sig
Keywords: 
Submitter: Embden Gansner
Date: 1/7/92
Version: ?
Severity: significant
Problem: 
    The BITS signature in perv.sig should have
	val notb : int -> int
    instead of 
	val notb : int * int -> int
Status: fixed in 0.81
----------------------------------------------------------------------
Number: 499
Title: execute broken
Keywords: 
Submitter: David Spooner (spoonerd@.cpsc.ucalgary.ca)
Date: 1/7/92
Version: 0.75
System: ?
Severity: major 
Problem: 
  No output availabe from execute.
Transcript: 
    Standard ML of New Jersey, Version 75, November 11, 1991
    Arrays have changed; see Release Notes
    val it = () :unit

    - val (instr,outstr) = execute ("ls", []);
    val instr = - :instream
    val outstr = - :outstream

    - input (instr, 5);
    val it = "" :string

    - can_input instr;
    val it = 0 :int
Fix: (luochen@shade.Princeton.EDU (Luoqi Chen))
    I believe the problem is in the runtime routine, ml_exec(), it calls
    execve(2) instead of execvp(3), so it won't look up in the PATH for the
    command. Try "/bin/ls" instead.

    The fix is simple, change the line (line 1238 of src/runtime/cfuns.c)
	    execve (cmd, argv, envp);
    to
	    { extern char **environ = envp;
	    execvp(cmd, argv);}
Status: fixed in 0.86
----------------------------------------------------------------------
Number: 500
Title: memory leak
Keywords: 
Submitter: Kjeld H. Mortensen, metasoft!kjeld@uunet.UU.NET, (617) 576.6920 x 22
Date: 1/7/92
Version: 0.75
System:
  SUN OS 4.1.1, ram 32Mb, swap 103Mb, and
  HPUX 8.0, ram 32Mb, swap 70Mb.
Severity: major
Problem: 
    During use of the extended compiler we see a significant slowdown of 
    this process when using v0.75 of SML/NJ (a factor 2 over a time period
    of 15 minutes reasonable heavy use, and doesn't seem to stop there).
Observations:
	1) We see absolutely no slow down when using v0.62 of SML/NJ on the
	   Sun4 (haven't been able to succesfully compile this version on
	   the HP9000 though).
	2) We see significant slow down when using v0.75 of SML/NJ on both
	   the Sun4 and HP9000. (In spite of the slow down, the compiler 
	   process gets more and more CPU-time.)
	3) Since we use the same ML-code in both cases 1) and 2), I'm lead to 
           conclude that it must be a problem in the SML/NJ system v0.75.

Example:
	Unfortunately I haven't been able to reproduce the phenomenon for a 
	reasonable small example.

Followup:
>...By the way, is your slow-down program mostly compiling things, or executing
>compiled code?

It is mostly executing compiled code.


I made some further investigations regarding the heap size. Each of the 
experiments performed, make up the same amount of work for the ML process
(work is measured in units of what I call "steps").

In the following table, "MEM-INC" is calculated using numbers from the first
and the last major collection. Let the output from the two major collections 
have the format:

	[Major collection... <P1>% used (<MUSED1>/<MTOT1>), <T1> msec]
	[Major collection... <Pn>% used (<MUSEDn>/<MTOTn>), <Tn> msec]

The numbers in "MEM-INC" then have the format: 

	<MUSEDn>-<MUSED1>/<MTOTn>-<MTOT1>,

"/" not to be confused with division.

The numbers in "Work" are only there to show that the compiler in each
experiment, did the same amount of computations.

Machine configurations:
   Sun4      , SUN OS 4.1.1, ram 32Mb, swap 103Mb, and
   HP9000s400, HPUX 8.0    , ram 32Mb, swap  70Mb.


Machine    | SML/NJ | Work/steps | MEM-INC/bytes | Number of major coll.
-----------+--------+------------+---------------+----------------------
Sun4       | v0.62  |     203    |  18292/179960 |          4
Sun4       | v0.75  |     201    | 425120/926324 |         12
HP9000s400 | v0.75  |     202    | 517352/931376 |         40

Comment: [dbm] This was probably fixed by restoring environment cleanup
(in 0.82).
Status: fixed in 0.84
----------------------------------------------------------------------
Number: 501
Title: out of date yacc example code
Keywords: 
Submitter: Andy Koenig
Date: 1/11/92
Version: ?
Severity: minor
Problem: 
  The calc.grm.sig, calc.grm.sml, and calc.lex.sml file in mlyacc/examples/calc
  needs to be updated.  Rerun ml-yacc and ml-lex on the appropriate files.
Fix:
In the calc directory are the following files:

README
calc.grm
calc.grm.desc
calc.grm.sig
calc.grm.sml
calc.lex
calc.lex.sml
join.sml
load.sml

Saying

	sml-lex calc.lex

rebuilds calc.lex.sml; saying

	sml-yacc calc.grm

rebuilds calc.grm.*

That should be done in the distribution directories so that people
will get the right versions.
[from Dave Tarditi:]
  The directory tools/mlyacc/examples contains some files
  which need to be regenerated by the new versions of
  the parser and lexer generator.

  You need to regenerate the files examples/calc/calc.grm.sml,
  examples/calc.lex.sml by running the parser generator
  on calc.grm and the lexer generator on calc.lex.

  Please remove the file examples/fol/fol.lex.sml.
Status: fixed in 0.91 (Tarditi)
----------------------------------------------------------------------
Number: 502
Title: zombie sml processes
Keywords: 
Submitter: Stephen Adams <S.R.Adams@ecs.southampton.ac.uk>
Date: 1/13/92
Version:        0.66, 0.75
System:         SunOS 4.1, sparc
Severity:       minor
Problem:        SML processes don't die if you log out
Code:           any running sml process
Comment:
    We use NJ-SML for teaching and research.  A common problem
    is if a user logs out (by selecting `exit' in X-windows, for
    example) the sml proces doesnt die, but sits there consuming
    cpu cycles (often > 40% of the cpu time).  With a large
    number of naive users this is a serious problem.  Even
    `sophisticated' users sometimes accidentally slug a machine
    for a few days.  It would be much friendlier to the
    community if an SML process running (foreground under a
    shell) under Xterm or under emacs would die when the user
    exits from X-windows or suntools.
Comment: [JHR]
	I was unable to reproduce this.  Perhaps there setup is such
	that a SIGHUP isn't getting generated.

>Date:		05-Aug-93
>Version:        0.93
>System:         SunOS 4.1.3, sparc, X11R5
>Problem:        SML processes don't die if you log out
>Code:           any running sml process

Because SML/NJ will used in our beginners' courses starting in october, this
seems to be a serious bug (just as S.Adams wrote).

To reproduce, I just
1. open a new xterm window (`tty` gives /dev/ttypa)
2. start smld
3. start 'top' in another window:
  PID USERNAME PRI NICE   SIZE   RES STATE   TIME   WCPU    CPU COMMAND
10161 sk         1    0  8752K 4308K sleep   0:04 14.48%  9.38% smld
4. 'destroy' the sml-xterm via twm, wait a few minutes
5. look into 'top' or 'ps x':
  PID USERNAME PRI NICE   SIZE   RES STATE   TIME   WCPU    CPU COMMAND
10161 sk         1    0  8752K   96K sleep   0:04  0.00%  0.00% smld

  PID TT STAT  TIME COMMAND
10161 pa S     0:04 sml

Note: the process still has tty pa.

Only a 'kill -9' can remove the process.

Could you please tell us what to do? Mr. Adams' argumentation applies to us,
too.

Tschau
	Stefan


  Stefan Kirchberg                      sk@irb.informatik.uni-dortmund.de
  Computer Science Department - IRB     Tel. from inside UniDO: 4700
  University of Dortmund                     from outside: 0231/755-2422
  44221 Dortmund, Germany               Office: GB V/R.325


Owner: John
Status: fixed in 109.21 [new runtime]
----------------------------------------------------------------------
Number: 503
Title: illegal instruction -- core dumps
Keywords: 
Submitter:	Markus Freericks
		mfx@cs.tu-berlin.de
Date:		1/28/92
Version:	0.75
System:		Sparc 2 (4/50), 16M, SunOS
Severity:	Major, at least for me
Problem:
When running my compiled program, sml encounters an "illegal
instruction" and dumps core. When the program is interpreted,
there is a message
-----------------------------------------------------------------------------
Error: Compiler bug: no default in interp
-----------------------------------------------------------------------------
the bug seems to occur in a totally normal case expression. I am
currently trying to isolate the error, but would like to know whether
there is some special thing to look for. I use an sml image that
contains the full Edinburgh library; the code that dumps core is part
of the semantic rules of a parser written in sml-yacc. The code is
heavy with functionals.
Just to get an idea of what the code looks like, the function where
the error occurs is
-----------------------------------------------------------------------------
fun makeParamDecl(oflag:bool,headId:S.T,(id,arglists:((S.T * Texpr) list list)),body : Texpr)=
  fn {env=E} =>
  let
    fun loop ([]:(S.T*Texpr)list list,comb:ACexpr->ACexpr,env) 
      = let
	  val {free=f,used=u,expr=e} = body {env=env}
	in
	  {defs = [id],
	   expr = {free=f,
		   used=u,
		   expr=comb(e)
		   }}
	end
      | loop (args::argss,comb,env) 
	= let
	    (* rename the parameters if necessary *)
	    val params = map #1 args
	    val typtexprs = map #2 args
	    val typacterms= map (fn x => x {env=env}) typtexprs
	    val typcterms = map (fn x => (output(std_out,"mpdloop1\n");
					  (case x of
					     (Complex(_)) => output(std_out,"complex\n")
					   | (Atomic(_)) =>  output(std_out,"atomic\n"));
					     output(std_out,"mpdloop2\n");
					     (case x of 
						Atomic(X) => X
					      | Complex(Y)=> (output(std_out,"error: type var must be atomic:\n");
							      Cterm.print std_out (Y objVar);
							      objVar))
						)) typacterms
	    val renames = renameSyms env params
	    val env' = Env.addList (ListPair.zip(params,renames)) env
	    val env''= putNewEE(putNewState(env))
	    val k = S.gen("_k")
	    fun comb' x = comb(Atomic(C.Lambda((ListPair.zip(renames,typcterms))@
					       [(k,objVar),
						(getEE env'',objVar),
						(getState env'',objVar)],
					       applyK(x,C.Var(k),env''))))
	  in
	    loop(argss,comb',env')
	  end
  in
    loop(arglists,(fn x=>x),E)
  end

Comment:
  when called, "mpdloop1" gets printed, then the error message appears.
  This is independent of the value of "x" (Atomic of Complex).
  As I said, am trying to reduce the error-generating code to manageable
  size and send that to you, but that may take a while.
Status: fixed in 0.75
----------------------------------------------------------------------
Number: 504
Title: Another core dump
Keywords: 
Submitter:	Markus Freericks
		mfx@cs.tu-berlin.de
Date:		1/28/92
Version:	0.75
System:		Sparc 2 (4/50), 16M, SunOS
Severity:	Major, at least for me

This is a followup to my earlier message. The following code dumps
core on my machine, even though it is interpreted!
(I hadn't got the nerve to reduce it any further, because startup-time
for sml on this system is in the order of 30 seconds)

Code:
SML_NJ.Control.interp :=true;

structure Symbol=Int

signature CTERM =
  sig
    datatype CONV = Check | Cast

    datatype T =
      Var of Symbol.T
    | Const of String.T
    | Apply of T list

    val print : outstream -> T -> unit

    end

structure Cterm : CTERM =
  struct
    datatype CONV = Check | Cast
    datatype T = 
      Var of Symbol.T
    | Const of String.T
    | Apply of T list

    fun indStringList indent =      
      fn Var(x) => [(indent,"var")]
       | Const(s) => [(indent,"const")]
       | Apply(args) =>
	   (List.foldR' 
	     (fn a => fn b => a @ b)
	     (map 
	      (fn (expr) => 
	       (indStringList (indent+1) expr))
	      args))

    fun print os x = ((indStringList 1 x);())
      
  end

structure B =
  struct
    structure S = Symbol
    structure SS = Int
    structure C = Cterm

    type Env = bool
      
    datatype ACexpr = 
      Atomic of C.T
    | Complex of C.T -> C.T 
      
    type TexprResult = {free:SS.T,used:SS.T,expr:ACexpr}
    type Texpr = {env:Env} -> TexprResult

    fun mkDummyExpr(x) : Texpr = fn {env=E} => {free = 1 ,
						used = 2 ,
						expr = Atomic(C.Const("\"dummyE:"^x^"\""))}
      
    val dummyExpr = mkDummyExpr("")
	  
    val objVar = C.Var(1)

    fun makeParamDecl((id,arglists:((S.T * Texpr) list list)),body : Texpr)=
      fn {env=E} =>
      let
	fun loop ([],comb:ACexpr->ACexpr,env) 
	   = let
	       val {free=f,used=u,expr=e} = body {env=env}
	     in
	       {defs = [id],
		expr = {free=f,
			used=u,
			expr=comb(e)
			}}
	     end
	   | loop (args::argss,comb,env) 
	     = let
		 (* rename the parameters if necessary *)
		 val params = map #1 args (* typcon mismatch if *)
					  (* commented out *)
		 val typtexprs = map (fn (a,b)=>b) args
		 val typacterms= map (fn x => x {env=env}) typtexprs
					(* typacterms=[Atomic(objVar)] would be ok *)
					(* [] instead of typtexprs would be ok,too *)
		 val _ = output(std_out,"makeParamDecl-2\n")
		 val typcterms = map (fn x => (output(std_out,"mpdloop1\n");
(*XXXX*)
					       (case x of
						  (Complex _) => output(std_out,"complex\n")
						| (Atomic _) =>  output(std_out,"atomic\n"));
						  output(std_out,"mpdloop2\n");
						  (case x of 
						     Atomic(X) => (
								   (*this here print causes the error!*)
								   Cterm.print std_out X;
								   X)
						   | Complex(Y)=> (output(std_out,"error: type var must be atomic:\n");
								   Cterm.print std_out (Y objVar);
								   objVar))
						     )) typacterms
		 val _ = output(std_out,"makeParamDecl-5\n")
	       in
		 loop(argss,comb,env)
	       end
      in
	loop(arglists,(fn x=>x),E)
      end
    
  end;

val xx = B.makeParamDecl((12,
			  [[(1,B.dummyExpr)]]),
			 B.dummyExpr
			 );
  
  
fun killMe() = xx({env=true})

(* calling killMe results in a bus error *)

killMe()

Comment:
  The main problem seems to be the type error at (*XXXX*): 
  "typtexprs" is of type "Texpr", so "typacterms" is a "TexprResult",
  not an "ACterm", as assumed by the "case x of Atomic...".

  This being undetected, a runtime error follows quite naturally. Funny
  enough, if the "Apply" clause in "indStringList" is removed by some
  simple rhs that doesn't inspect the argument of the Apply, no runtime error
  occurs.

  PS. After having found the type error, the function runs fine. Guess
  that makes the Severity "minor, at least for me".

Status: fixed in 0.75
----------------------------------------------------------------------
Number: 505
Title: bad datatype definition accepted
Keywords: 
Submitter: John Reppy
Date: 1/28/92
Version: 0.76
Severity: minor
Problem: 
  The following is not legal SML (cf. Definition, sec 2.9), but is
  accepted by the compiler:
Transcript: 
  Standard ML of New Jersey, Version 0.76, December 14, 1991
  Arrays have changed; see Release Notes
  val it = () : unit
  - datatype foo = FOO of int | BAR and bar = BAR;
  datatype  foo
  con BAR : foo
  con FOO : int -> foo
  datatype  bar
  con BAR : bar
Status: fixed in 0.91 (dbm)
----------------------------------------------------------------------
Number: 506
Title: Runbind exception
Keywords: 
Submitter:      Thomas M. Breuel <tmb@ai.mit.edu>
Date:		1/31/92
Version:        0.75
System:         SparcStation IPC SunOS 4.1.1
Severity:       major (?)
Problem:        code dies with "uncaught exception Runbind" when put
		into "structure All"
Code:

local type time = System.Timer.time
    val timeofday : unit -> time = 
	System.Unsafe.CInterface.c_function "timeofday"
in 
    fun timeit f  = 
	let open System.Timer
	    val t = start_timer()
	    val rt = timeofday()
	    val z = f ()
	    val rt' = sub_time(timeofday(),rt)
	    val t' = check_timer t
	    val ts = check_timer_sys t
	    val tg = check_timer_gc t
	in
	    print(implode["user: ",makestring t',
			  "  gc: ", makestring tg, 
			  "  system: ",makestring ts,
			  "  real: ",makestring rt',"\n"]);
	    z
	end
end;

structure All = struct

signature RA2 =
    sig
	exception Subscript
	type array
	val array : (int * int) * real -> array
	val dim : array * int -> int
	val sub : array * (int * int) -> real
	val update : array * (int * int) * real -> unit
    end;

structure X:RA2 =
    struct
	structure R = RealArray
	exception Subscript = R.RealSubscript
	datatype array = A of (int * int) * R.realarray
	fun array((d0,d1),initial) = A((d0,d1),R.array(d0*d1,initial))
	fun dim(A((d0,d1),_),0) = d0
	  | dim(A((d0,d1),_),1) = d1
	  | dim _ = raise Subscript
	fun sub(A((d0,d1),a),(i,j)) = R.sub(a,i*d1+j)
	fun update(A((d0,d1),a),(i,j),v) = R.update(a,i*d1+j,v)
    end;

structure Y:RA2 =
    struct
	structure R = RealArray
	structure A = Array
	exception Subscript = R.RealSubscript (*HACK*)
	type array = R.realarray A.array
	fun dim(a,0) = A.length(a)
	  | dim(a,1) = R.length(A.sub(a,0))
	  | dim _ = raise Subscript
	fun array((d0,d1),initial) = A.tabulate(d0,fn j => R.array(d1,initial))
	fun sub(a,(i,j)) = R.sub(A.sub(a,i),j)
	fun update(a,(i,j),v) = R.update(A.sub(a,i),j,v)
    end;

functor Test(A2:RA2) =
    struct
	fun dotimes(n,f) =
	    let
		fun loop(i) = if i>=n then () else (f(i); loop(i+1))
	    in
		loop(0)
	    end
	fun foldtimes(n,r,f) =
	    let
		fun loop(i,r) = if i>=n then r else loop(i+1,f(r,i))
	    in
		loop(0,r)
	    end
	fun a before b = a
	fun fold(a,r,f) =
	    foldtimes(A2.dim(a,1),r,fn (r,y) =>
		      foldtimes(A2.dim(a,0),0.0,fn (r,x) =>
				(f(r,A2.sub(a,(x,y)))) before (A2.update(a,(x,y),r))))
	fun bound(x) = if x>=1.0 then bound(x-1.0) else x
	fun combine(x,y) = bound(x*1.17812+y)
	fun doit() =
	    let
		val w = 512
		val h = 512
		val a = A2.array((w,h),0.0001)
	    in
		dotimes(2,fn i => fold(a,0.0,combine))
	    end
	val _ = timeit(doit)
    end;

end;

open All;

Transcript:

Standard ML of New Jersey, Version 75, November 11, 1991
Arrays have changed; see Release Notes
val it = () : unit
- [opening compare.sml]
val timeit = fn : (unit -> 'a) -> 'a
compare.sml:25.1-33.7 Warning: signature found inside structure or functor
compare.sml:62.1-92.7 Warning: functor found inside structure or functor
structure All : 
  sig
    signature RA2 = 
      sig
        exception Subscript
        type array
        val array : (int * int) * real -> array
        val dim : array * int -> int
        val sub : array * (int * int) -> real
        val update : array * (int * int) * real -> unit
      end
    functor Test : <sig>
    structure X : RA2
    structure Y : RA2
  end
open All
[closing compare.sml]
val it = () : unit
- structure Dummy = Test(X);

uncaught exception Runbind
- 

Comments:

This seems to be different from the bugs relating to Runbind in
the masterbugs list (all of those claim to have been fixed or
claim to be unreproducible).

Status: fixed in 0.84
----------------------------------------------------------------------
Number: 507
Title: most negative integer causes compiler bug (see also 630, 632)
Keywords: 
Submitter: Thomas Yan (tyan@cs.cornell.edu)
Date: 2/3/92
Version: 0.75?
Severity: minor
Problem: 
  Sometimes the compiler has problems with the most negative integer:
Transcript: 
    fun f ~0x40000000 = 7;
    std_in:1.1-1.21 Warning: match not exhaustive
    ~1073741824 => ...
    Error: Compiler bug: Overflow in cps/generic.sml
    - 
Status: fixed in 0.90
----------------------------------------------------------------------
Number: 508
Title: xorb
Keywords: 
Submitter: Thomas Yan (tyan@cs.cornell.edu)
Date: 2/3/92
Version: 0.75?
Severity: minor
Problem: 
  xorb gives wrong answer
Transcript:
    - fun f x = x xorb  ~0x40000000;
    val f = fn : int -> int
    - f 0;
    val it = 
    uncaught exception Boxity
    - fun f x = x xorb  ~0x40000000;
    val f = fn : int -> int
    - f 0;
    val it = ~1073741824 : int
    - 
Status: fixed in 0.84
----------------------------------------------------------------------
Number: 509
Title: compiler bug in number pattern
Keywords: 
Submitter: Thomas Yan (tyan@cs.cornell.edu)
Date: 2/3/92
Version: 0.75?
Severity: minor
Problem: 
  Compiler bug in hexidecimal pattern
Transcript:
    - fun f 0x3fffffff = 2;
    std_in:3.1-3.20 Warning: match not exhaustive
    1073741823 => ...
    Error: Compiler bug: Overflow in cps/generic.sml
Comment:
    After looking at cps/generic.sml, I think the problem is with generating code
    with immediate data.  Often, things like (INT u) op v get translated into
    <machine op> (immed (u+u)) v, where the u+u is for the boxity scheme (the +1
    comes from v).  But when u is already near the limit, then u+u overflows.
    Obviously, it would be nice for this to get fixed.
Status: fixed in 0.90
----------------------------------------------------------------------
Number: 510
Title: poor error message in ml-lex (same as 475)
Keywords: 
Submitter: Reppy
Date: 2/1/92
Version: 0.75?
Severity: minor?
Problem: 
The following lex file

  %%
  special = [@#$%^&*_+=|\\/<>-];
  %%
  <INITIAL>\n      => (inc ln; lex());

produces

  ? sml-lex: uncaught exception LOOKUP

Comments:
  I believe this is because there are special characters in the [...],
  but this is a poor error message.
Status: same as 475
----------------------------------------------------------------------
Number: 511
Title: dying on interupt with SIGEMT (same as 484, 518)
Keywords: 
Submitter:	tmb@ai.mit.edu (Thomas M. Breuel)
Date:		1/14/92
Version:	0.75
System:		SunOS 4.1.?, Sparc IPC
Severity:	major
Problem:	When typing Control-C, the system dies with a SIGEMT
Code:		(this doesn't seem to be specific to any code)
Transcript:

- trymatches(model,image,BoundedMatch.eval,5.0,10.0,0.4);
((17.0,11.0),(222.0,175.0))
((5.0,5.00028),(552.0,473.0))
((~217.0,~169.99972),(535.0,462.0))
~217.0
~212.0
SIGEMT not related to gc (bogus test: 0x9de3bfc0 @ 0xa150)

Process Inferior mysml exited abnormally with code 3

Comments:
    This is also given as bug 304 in the "masterbugs" list, but it is not
    listed in the "openbugs" list anymore. Did this bug come back or was
    it never fixed?
    Based on the PC info, this was probably an OS bug.  Changes to the
    GC invocation mechanism mean that it is moot. -- JHR
Status: fixed in 0.93
----------------------------------------------------------------------
Number: 512
Title: compiler looping
Keywords: 
Submitter:      tmb@ai.mit.edu
Date:		1/15/92
Version:        0.75 (loaded+dumped mylib)
System:         SunOS 4.1.?, Sparc IPC
Severity:       major
Problem:        compiling the red-black tree code below inside the
		"structure ... = struct ... end" fills up memory
		and doesn't seem to terminate; compiling at top-level
		works fine
Code:

(* Red-Black Trees *)

signature ODICT =
    sig
	type 'a Dict
	val lookup : ('a -> 'b) * ('b * 'b -> bool) * 'a Dict * 'b -> 'a
	val insert : ('a -> 'b) * ('b * 'b -> bool) * 'a Dict * 'a -> 'a Dict
	val aslist : 'a Dict -> 'a list
    end;

structure RBTree:ODICT =
    struct
	datatype Color = Rd | Bl
	datatype 'a Node = ND of Color * 'a * 'a Node * 'a Node | LEAF;

	type 'a Dict = 'a Node
	    
	fun aslist(LEAF) = []
	  | aslist(ND(c,k,l,r)) = aslist(l) @ k @ aslist(r)
	    
	exception Lookup
	
	fun lookup(key,less,LEAF,k) = raise Lookup
	  | lookup(key,less,ND(_,v,l,r),k) =
	    if less(k,key(v)) then lookup(key,less,l,k)
	    else if less(key(v),k) then lookup(key,less,r,k)
	    else v
		
	fun rewrite(ND(Bl,B,ND(Rd,A,alpha,beta),ND(Rd,C,gamma,delta))) =
	    (ND(Rd,B,ND(Bl,A,alpha,beta),ND(Bl,C,gamma,delta)))
	  | rewrite(ND(Bl,C,ND(Rd,A,alpha,ND(Rd,B,beta,gamma)),delta)) =
	    ND(Bl,B,ND(Rd,A,alpha,beta),ND(Rd,C,gamma,delta))
	  | rewrite(ND(Bl,C,ND(Rd,B,ND(Rd,A,alpha,beta),gamma),delta)) =
	    ND(Bl,B,ND(Rd,A,alpha,beta),ND(Rd,C,gamma,delta))
	  | rewrite(ND(Bl,A,alpha,ND(Rd,B,ND(Rd,C,beta,gamma),delta))) =
	    ND(Bl,B,ND(Rd,A,alpha,beta),ND(Rd,C,gamma,delta))
	  | rewrite(ND(Bl,A,alpha,ND(Rd,B,beta,ND(Rd,C,gamma,delta)))) =
	    ND(Bl,B,ND(Rd,A,alpha,beta),ND(Rd,C,gamma,delta))
	  | rewrite x = x;

	fun insert(key,less,v,tree) =
	    let
		fun insert'(LEAF) = ND(Rd,v,LEAF,LEAF)
		  | insert'(ND(Bl,v',left,right)) =
		    if less(key(v),key(v')) then
			rewrite(ND(Bl,v',insert'(left),right))
		    else if less(key(v'),key(v)) then
			rewrite(ND(Bl,v',left,insert'(right)))
		    else
			ND(Bl,v',left,right)
		  | insert'(ND(Rd,v',left,right)) =
		    if less(key(v),key(v')) then
			ND(Rd,v',insert'(left),right)
		    else if less(key(v'),key(v)) then
			ND(Rd,v',left,insert'(right))
		    else
			ND(Rd,v',left,right);
		val ND(_,v,l,r)=insert'(tree)
	    in
		ND(Bl,v,l,r)
	    end
	
	fun create(key,less,l) =
	    let
		fun loop([],r) = r
		  | loop(x::xs,r) = loop(xs,insert(key,less,x,r))
	    in
		loop(l,LEAF)
	    end;
	    
	fun id x = x
	fun lt(x:int,y) = x<y
    end;

Transcript:

NJ/SML, mylib
val it = () : unit
- 			<--- I've comented out the structure...
                             surrounding the Red-Black tree code
[opening redblack.sml]
signature ODICT = 
  sig
    type 'a Dict
    val lookup : ('b -> 'a) * ('a * 'a -> bool) * 'b Dict * 'a -> 'b
    val insert : ('b -> 'a) * ('a * 'a -> bool) * 'b Dict * 'b -> 'b Dict
    val aslist : 'a Dict -> 'a list
  end
datatype  Color
con Bl : Color
con Rd : Color
datatype 'a  Node
con LEAF : 'a Node
con ND : Color * 'a * 'a Node * 'a Node -> 'a Node
type 'a  Dict = 'a Node
val aslist = fn : 'a list Node -> 'a list
exception Lookup
val lookup = fn : ('a -> 'b) * ('b * 'b -> bool) * 'a Node * 'b -> 'a
val rewrite = fn : 'a Node -> 'a Node
redblack.sml:56.3-56.31 Warning: binding not exhaustive
        ND (_,v,l,r) = ...
val insert = fn : ('a -> 'b) * ('b * 'b -> bool) * 'a * 'a Node -> 'a Node
val create = fn : ('a -> 'b) * ('b * 'b -> bool) * 'a list -> 'a Node
val id = fn : 'a -> 'a
val lt = fn : int * int -> bool
[closing redblack.sml]
val it = () : unit
- 			<--- I've put the structure ... = struct ... end back
[opening redblack.sml]
signature ODICT = 
  sig
    type 'a Dict
    val lookup : ('b -> 'a) * ('a * 'a -> bool) * 'b Dict * 'a -> 'b
    val insert : ('b -> 'a) * ('a * 'a -> bool) * 'b Dict * 'b -> 'b Dict
    val aslist : 'a Dict -> 'a list
  end

[Major collection...
[Increasing heap to 3420k]

[Increasing heap to 3560k]

[Increasing heap to 4260k]

[Increasing heap to 7760k]
 69% used (1952632/2809440), 2100 msec]

[Increasing heap to 8192k]

[Major collection... 94% used (3980248/4209932), 4600 msec]

[Increasing heap to 12344k]

[Major collection...
[Increasing heap to 18924k]
 94% used (6180760/6516556), 7060 msec]

[Increasing heap to 19104k]

[Major collection...
[Increasing heap to 29280k]

Process Inferior sml killed		<--- kill -9 <pid>

Comments:

BTW, do you have code to delete from persistent red-black trees?  It
gets really messy...
Status: fixed in 0.84
----------------------------------------------------------------------
Number: 513
Title: not waiting for execute children
Keywords: 
Submitter: Robert S. Thau (rst@ai.mit.edu)
Date: 1/20/92
Version: ?
Severity: major
Problem: 
  SML/NJ appears not to wait for children forked off by execute.  This can be
  a problem in certain circumstances.  In my particular case, I wrote a
  routine which draws graphs for the user by forking off an xplot and sending
  down plot commands.  After fifty graphs or so, the zombie xplots had
  completely filled my per-user process limit, making it difficult to
  determine the nature of the problem (ps: cannot fork: no more processes).

  In this particular case, I'd be more than willing to do the wait myself,
  but execute gives me no process-id to wait for, just the input and output
  streams. 

  [from Phil Jeffcock <P.J.Jeffcock@bradford.ac.uk>, 3/2/92]
  I'm running SML/NJ 0.75 on my SUN Sparc IPC. I've been writing an application
  which I need to use execute frequently and in doing so the ML runtime is
  creating a zombie process each time I use it. After a short while I run out
  of process slots. Any ideas?
Fix:
  just before doing the execute, do wait3(&status,WNOHANG,NULL) to clean
  up previous children, if any.
Status: fixed in 0.91 
----------------------------------------------------------------------
Number: 514
Title: uncaught exception ErrorStructure
Keywords: 
Submitter: John Reppy
Date: 1/15/92
Version: 0.76
Severity: minor
Problem: 
    I got the following uncaught exception when working on my Amber stuff:

      ...
      [opening join.sml]
      join.sml:6.25-6.38 Error: unbound functor: AmberLrValsFun
      [closing join.sml]
      [closing load]

      uncaught exception ErrorStructure
      - 

    I tried a few small examples, but I wasn't able to reproduce the
    bug.  The offending file ("join.sml") is:

      structure AmberLrVals = AmberLrValsFun (structure Token = LrParser.Token)
      structure AmberLex = AmberLexFun (structure Tokens = AmberLrVals.Tokens)
      structure AmberParser = Join (
	structure ParserData = AmberLrVals.ParserData
	structure Lex = AmberLex
	structure LrParser = LrParser)

    If I add a ";" to the first line, then I just get the error message.

  [from Jon Thackray <jont@harlqn.co.uk>, 4/8/92]:
     Ok, here's a stripped down version of the ErrorStructure problem. I
  don't believe it can get any smaller. The significant factors seems to
  be twofold, firstly, the missing parameter to the Mir_Utils functor,
  and secondly the sharing constraint between the parameters of this
  functor. The first factor in isolation is not sufficient to produce
  the problem, as far as I can tell. Hope this helps.

  signature MIRTYPES =
    sig
    end;

  signature MIRPRINT =
    sig
      structure MirTypes	: MIRTYPES
    end;

  functor Mir_Utils(
    structure MirTypes : MIRTYPES
    structure MirPrint : MIRPRINT

    sharing MirTypes = MirPrint.MirTypes
  ) =
  struct
  end;

  structure MirTypes_ =
    struct
    end;

  structure Mir_Utils_ = Mir_Utils(
    structure MirTypes = MirTypes_
  );

Status: fixed in 0.84
----------------------------------------------------------------------
Number: 515
Title:  Compiler bug: patType -- unexpected pattern
Keywords: 
Submitter:      jont@uk.co.harlqn
Date:		24/01/92
Version:        SML of NJ version 0.75
System:         Sun 4/330 with Sunos 4.1.1
Severity:       minor
Problem:        Compiler bug
Code:
    | has_a_new_name (TYFUN (CONSTYPE (_,METATYNAME{ref tyfun, ...}),_)) =

Transcript:

/usr/users/jont/ml/ml_compiler/src/typechecker/_types.sml:383.57-383.61 Error: syntax error: inserting AS
/usr/users/jont/ml/ml_compiler/src/typechecker/_types.sml:1177.38 Error: syntax error: inserting ASTERISK
Error: Compiler bug: patType -- unexpected pattern
[closing /usr/users/jont/ml/ml_compiler/src/typechecker/_types.sml]
Comments: same as #474?
Status: fixed in 0.83 (probably)
----------------------------------------------------------------------
Number: 516
Title: ml-lex gives uncaught exception LOOKUP (same as 475, 510)
Keywords: 
Submitter: John Reppy
Date: 2/4/92
Version: ?
Severity: significant
Problem: 
One of my students was getting the following mysterious error message
from mllex:

  ? sml-lex: uncaught exception LOOKUP

upon examination, the problem is that he misspelled a character class
name.  The following small file will produce this behavior:
Code: 
  <jhr@bat> cat foo.lex
  (* test file *)

  %%

  foo = [a-z];

  %%

  <INITIAL>{foob}+                => (lex());
Status: same as 475
----------------------------------------------------------------------
Number: 517
Title: type errors in examples/cat.sml
Keywords: 
Submitter: Doug McIlroy
Date: 2/4/92
Version: ?
Severity: minor
Problem: 
  doc/examples/cat.sml contains type errors
Status: fixed in 0.90 (in /usr/local/sml/75/doc/examples/cat.sml)
----------------------------------------------------------------------
Number: 518
Title: interrupt causes core dump (same as 484, 511)
Keywords: 
Submitter:      jont@uk.co.harlqn
Date:		12/02/92
Version:        SML of NJ version number 0.75
System:         Sun 4/330 with SunOS 4.1.1
Severity:       minor
Problem:        Unreliability of NJ 0.75 with ^c
Transcript:
SIGEMT not related to gc (bogus test: 0x9de3bfc0 @ 0xa150)

Comments:
  This seems to happen a lot when using ctrl-c to halt a looping or long
  running program. Even if this doesn't happen, the image sometimes
  seems corrupt afterwards, in that it exhibits strange (impossible)
  behaviour that doesn't occur if it is recompiled from scratch to
  supposedly the same state. I suspect there is a critcial region
  problem somewhere.
Status: obsolete
----------------------------------------------------------------------
Number: 519
Title: System.system broken after loading sml-yacc output
Keywords: 
Submitter: John Nestoriak <nestorak@cs.psu.edu>
Date: 2/16/92
Version: 0.75
Severity: major
Problem: 
  I'm having a problem using system calls from sml 75.  Something like 
  System.system "ls"; works fine until I load the output from sml-yacc.  Then
  I get uncaught exception SystemCall.  

  [from cazin@tls-cs.cert.fr (Jacques Cazin), 3/26/92]
  But we use also lexgen and mlyacc which are in the distribution. After
  having loaded lexgen, we cannot use "System.system" anymore:

		  System.system "pwd";  (or anything else)
  gives rise to 
		  uncaught exception SystemCall

  We  previously used  version  0.56 with  lexgen as  well  and  did not
  observe this behaviour.
Status: fixed in 0.86
----------------------------------------------------------------------
Number: 520
Title: broken under IRIX 4.0.1
Keywords: 
Submitter: Lindsay Errington <lindsay@cs.mu.OZ.AU>
Date: 2/17/92
Version: 0.75
System: SGI/IRIX 4.0.1
Severity: major
Problem: 
  I'm sorry to bother you with such a vague problem but I'm having a
  little trouble with your compiler under IRIX.  We've just upgraded from
  Irix 3.3.x to version 4.0.1 and since then any attempt to use the "use"
  function made SML 0.75 hang. I tried to re-compile the runtime but then
  it only gets as far as [Executing IEEEReal] before it hangs again. I've
  done a little diddling and as far as I can tell it's hung in prim.s.
  Any suggestions on where to start looking or whom to contact?
Status: fixed in 0.81
----------------------------------------------------------------------
Number: 521
Title: type checking flex records
Keywords: 
Submitter:      Mark Leone (mleone@cs.cmu.edu)
Date:		2/12/92
Version:        0.75
System:         Decstation 2100 under Mach 2.6
Severity:       major
Problem:        Type checker doesn't handle flex records correctly.
Code:           fun foo x = let val a = #1 x
                                val (a,b) = x
	                    in
      		                b ()
       	                    end
Transcript:
  Standard ML of New Jersey, Version 75, November 11, 1991
  Arrays have changed; see Release Notes
  val it = () : unit
  - fun foo x = let val a = #1 x
		    val (a,b) = x
		in
		    b ()
		end
  ;
  = = = = = val foo = fn : 'a * 'b -> 'c
  - foo (0,0);

  Process sml segmentation fault
Comments: Type of foo should be ('a * (unit -> 'b)) -> 'b
Status: fixed in 0.85
----------------------------------------------------------------------
Number: 522
Title: redundent patterms in compiler
Keywords: 
Submitter: John Reppy
Date: 2/18/92
Version: 0.76?
Severity: minor
Transcript: 
  build/index.sml:177.4 Warning: redundant patterns in match
	  VALdec vbs => ...
	  VALRECdec rvbs => ...
	  TYPEdec tbs => ...
	  DATATYPEdec {datatycs=datatycs,withtycs=withtycs} => ...
	  ABSTYPEdec {abstycs=abstycs,body=body,withtycs=withtycs} => ...
	  EXCEPTIONdec ebs => ...
	  STRdec sbs => ...
	  ABSdec sbs => ...
	  FCTdec fbs => ...
	  SIGdec sigvars => ...
	  LOCALdec (inner,outer) => ...
	  SEQdec decs => ...
	  OPENdec strVars => ...
	  MARKdec (dec,L1,L2) => ...
	  FIXdec _ => ...
	  OVLDdec _ => ...
	  IMPORTdec _ => ...
    -->   _ => ...
  translate/translate.sml:259.30 Warning: redundant patterns in match
	  VALtrans (PATH p) => ...
	  VALtrans (INLINE POLYEQL) => ...
	  VALtrans (INLINE POLYNEQ) => ...
	  VALtrans (INLINE INLSUBSCRIPT) => ...
	  VALtrans (INLINE INLUPDATE) => ...
	  VALtrans (INLINE INLBYTEOF) => ...
	  VALtrans (INLINE INLSTORE) => ...
	  VALtrans (INLINE INLORDOF) => ...
	  VALtrans (INLINE INLFSUBSCRIPTd) => ...
	  VALtrans (INLINE INLFUPDATEd) => ...
	  VALtrans (INLINE i) => ...
	  THINtrans (PATH p,v,locs) => ...
	  CONtrans (d as DATACON {const=true,...}) => ...
	  CONtrans (d as DATACON {const=false,...}) => ...
	  VALtrans a => ...
	  THINtrans (a,_,_) => ...
    -->   _ => ...

  cps/cpsopt.sml:1129.4 Warning: redundant patterns in match
	  RECORD (vl,w,e) => ...
	  SELECT (i,v,w,e) => ...
	  OFFSET (i,v,w,e) => ...
	  APP (f,vl) => ...
	  FIX (l,e) => ...
	  SWITCH (v,_,el) => ...
	  BRANCH (_,vl,c,e1,e2) => ...
	  LOOKER (_,vl,w,e) => ...
	  SETTER (_,vl,e) => ...
	  PURE (_,vl,w,e) => ...
	  ARITH (args as (floor,_,_,_)) => ...
	  ARITH (args as (round,_,_,_)) => ...
	  ARITH (args as (fadd,_,_,_)) => ...
	  ARITH (args as (fdiv,_,_,_)) => ...
	  ARITH (args as (fmul,_,_,_)) => ...
	  ARITH (args as (fsub,_,_,_)) => ...
	  ARITH (_,vl,w,e) => ...
    -->   PURE (args as (fnegd,v :: nil,w,e)) => ...
    -->   PURE (real,vl,w,e) => ...
Status: fixed in 0.81
----------------------------------------------------------------------
Number: 523
Title: printing uncaught exceptions
Keywords: 
Submitter:      Richard O'Neill <richard@smaug.questor.wimsey.bc.ca>
Date:		2/27/92
Version:        0.75
System:         NeXTstation, OS2.1
Severity:       Major annoyance
Problem:        
If a value happens to be of type exn, the top level loop won't
print out the value, but instead says 'val it = exn : exn'; this
is not acceptable behaviour in my opinion.

When debugging, I like to be able to pass back information when an
fatal exception is raised. It is bad enough that if you have:

	exception InvalidKey of int;
  ...
	raise InvalidKey 6502;

it gives the message

	uncaught exception InvalidKey
and not:
	uncaught exception: InvalidKey 6502

(But the 'Io' exception does 'do the right thing'- special case
treatment or what :o)

But I can put up with that - what really annoys me is that even
the top level won't print exception values, i.e.

	- val theException = InvalidKey 6502;
	val theException = exn : exn

In order to find the value, I need to do:

	- case theException of InvalidKey key => key;
	std_in:3.1-3.42 Warning: match not exhaustive
		InvalidKey key => ...
	val it = 6502 : int

This is annoying, because it means more work for me to do, especially
if the datastructure is a *chain* of exception values (e.g. something
like 'exception ReraiseBacktrace of functionName * parameters *
exn' - you get the idea anyway). In such a case, I have to follow
the chain *by hand*.

I realise that printing exeptions may be harder than printing
ordinary constructors, but don't think this is a good reason not
to print them.

[Richard O'Neill, 11/24/92]
Standard ML of New Jersey, Version 0.92, November 18, 1992
val it = () : unit
- val some_exceptions = [Interrupt, Match, Bind, Io "Foobar"];
val some_exceptions = [exn,exn,exn,exn] : exn list
- ^D

If a value happens to be of the exception type, it is always printed
in a most uninformative way.

Obviously, I'd like to see:

Standard ML of New Jersey, Version 0.93, February 17, 1993 ;-)
val it = () : unit
- val some_exceptions = [Interrupt, Match, Bind, Io "Foobar"];
val some_exceptions = [Interrupt, Match, Bind, Io "Foobar"] : exn list
- ^D

Thus bug already has a number, 523, but the title "printing uncaught
exceptions" is misleading, and I expect probably the reason it hasn't
been fixed (yet). (Better printing of uncaught exceptions would be nice
too, but that is far less important to me).

Unless I'm seriously mistaken, this bug would only take minutes to fix, for
someone who knows SML-NJ's data-structures.

Comment: (awa)
Fixed a little bit; exn values now print a top level, but not the
value carried by the constructor.

Status: not  a bug (entirely)
----------------------------------------------------------------------
Number: 524
Title: weak polymorphism
Keywords: 
Submitter: shail@au-bon-pain.lcs.mit.edu (Shail Aditya)
Date: 12/19/91
Version: ?
Severity: major
Problem: 
	  I ran across this quirk in the ranked weak type inference in
  SML-NJ. I am running the version 0.75 on Sparc (sunos). 

  - val g3 = (fn f => (fn x => f x));
  val g3 = fn : ('a -> 'b) -> 'a -> 'b

  - g3 ref;
  std_in:5.1-5.6 Error: nongeneric weak type variable
    it : '0Z -> '0Z ref
  -

  The "ref" does not happen until another argument is supplied to "g3
  ref", so proper ranking analysis should have made its type to be 
  "'1a -> '1a ref" without any error.

  - val g = (fn x => x);
  val g = fn : 'a -> 'a
  - g ref;
  std_in:3.1-3.5 Error: nongeneric weak type variable
    it : '0Z -> '0Z ref

  But the following works.

  - val h = (fn x => let val g = fn x => x in g ref end);
  val h = fn : 'a -> '1b -> '1b ref
  -  val h = (fn x => let val g = (fn f => (fn x => f x)) in g ref end);
  val h = fn : 'a -> '1b -> '1b ref
  - 

  Basically, it seems that "ref" is opened up to the enclosing lambda
  rank unnecessarily when it is passed as an argument. This system works
  fine in first order situations but fails in higher order argument
  passing when the arguments are weakly polymorphic functions. 

  Am I to understand that the ranked system of SML-NJ is not powerful
  enough to keep track of weak polymorphism across higher order function
  applications? Or is this merely a bug? 

  I would like to obtain a clearer description of the ranked system you
  follow. Preferably in terms of a paper that gives the inference rules.
  I have a system that behaves similarly, only that it allows toplevel
  non-ground weak types as well. I would like to know the SML-NJ
  solution better. Do you have any pointers? 
Status: not a bug (a "feature" of weak polymorphism)
----------------------------------------------------------------------
Number: 525
Title: IO.execute broken
Keywords: 
Submitter:	Mikael Pettersson, mpe@ida.liu.se
Date:		1/7/92
Version:	0.75
System:		SPARCstation ELC, SunOS 4.1.1
Severity:	major
Problem:	the input stream from IO.execute is unusable:
		can_input and close_in fail with exceptions,
		input causes a segmentation violation
Transcript:
  ====
  - val (is,_) = execute("/bin/echo",["foo"]);
  val is = - : instream
  - close_in is;

  uncaught exception Io "close_in "<pipe_in>": close failed, Bad file number"
  ====
  - val (is,_) = execute("/bin/echo",["foo"]);
  val is = - : instream
  - input(is,1);
  Segmentation fault (core dumped)
  ====
  - val (is,_) = execute("/bin/echo",["foo"]);
  val is = - : instream
  - can_input is;

  uncaught exception SystemCall
  - (can_input is) handle (System.Unsafe.CInterface.SystemCall s) => (print s; print "\n"; 999);
  fionread failed, Bad file number
  val it = 999 : int
Status: fixed in 0.84
----------------------------------------------------------------------
Number: 526
Title: Harlequin gripes
Keywords: 
Submitter: Andrew Tolmach
Date: 3/2/92
Version: 0.75
Severity: minor
Problem: 
  1) If one uses polymorphic equality on, say, integer types, the equality test
  is much slower than using a type-specific equality operator.  This was probably
  in the context of functors, in which case its no big surprise, but might
  bear looking into further.

  2) They were unhappy with the time cost of referencing elements out of
  structures at runtime.  They often do something like inserting an explicit
  declaration

    val thing = A.thing

  same thing for them automatically.  They also suggested that we don't tend
  to notice this problem because we use "open" all over the place, a practice
  they abominate.
Status: not a bug
----------------------------------------------------------------------
Number: 527
Title: uncaught exception Subscript while printing value of a datatype
Keywords: 
Submitter: John Reppy
Date: 3/9/92
Version: 0.78
Severity: major
Problem: 
  compiling following code causes uncaught exception Subscript
Code: 
(* string-util.sml
 *
 * Various string utilities.
 *)

structure StringUtil =
  struct

    datatype relation_t = Equal | LessTh | GreaterTh

  (* lexically compare two strings and return their relation *)
    fun strcmp (s1, s2) = (case (size s1, size s2)
	   of (0, 0) => Equal
	    | (0, _) => LessTh
            | (_, 0) => GreaterTh
            | (n1, n2) => let
		fun loop i = let
		      val c1 = ordof(s1, i) and c2 = ordof(s2, i)
                      in
                         if (c1 = c2)
                           then loop(i+1)
                         else if (c1 < c2)
                           then LessTh
                           else GreaterTh
                      end
                in
                  (loop 0) handle _ => (
                     if (n1 = n2)
                       then Equal
                     else if (n1 < n2)
                       then LessTh
                       else GreaterTh)
		end (* strcmp *)
	    (* end case *))

  (* Lexically sort a list of values with unique string keys.  The function
   * proj extracts the key of an item.  Raise Repeat if two items have the
   * same key.
   *)
    exception Repeat of string
    fun sortStrings proj = let
	  fun le (f1, f2) = (case strcmp(proj f1, proj f2)
		 of LessTh => true
		  | GreaterTh => false
		  | Equal => raise Repeat(proj f1)
		(* end case *))
	  fun insert (f, []) = [f]
	    | insert (f, l as (f'::r)) =
		if le(f, f') then f::l else f'::insert(f, r)
	  fun sort ([], l) = l
	    | sort (f::r, l) = sort(r, insert(f, l))
	  in
	    fn l => sort (l, [])
	  end

  end (* StringUtil *)

(* this is a SML implementation of Luca's Amber code *)

(* Types are represented by values in the following type.  Rec bound variables
 * in a recursive type are represented by the RecTy node in which they are bound.
 * For example, the representation of the following Amber type
 *
 *   rec (t) [nil : Unit, cons : {hd : Int, tl : t}]
 *
 * is constructed by the following ML code:
 *
 * let
 *   val recBody = ref Any
 *   val recTy = RecTy{bind = "t", typ = recBody}
 *   val body = VariantTy[
 *           FieldTy{tag = "nil", typ = BaseTy UnitTy},
 *           FieldTy{tag = "cons", typ = RecordTy[
 *               FieldTy{tag = "hd", typ = BaseTy IntTy},
 *               FieldTy{tag = "tl", typ = recTy},
 *             ]
 *         ]
 * in
 *   recBody := body;
 *   recTy
 * end
 *)

datatype base_ty = UnitTy | BoolTy | IntTy | StringTy | DynamicTy

datatype typ
  = AnyTy
(*  | ExistTy of {name : string, instance : typ option, suptypes : typ list}*)
  | BaseTy of base_ty
  | FunTy of (typ * typ)
  | TupleTy of typ list
  | RecordTy of field_ty list		(* assume fields are sorted by tag *)
  | VariantTy of field_ty list
  | RecTy of {bind : string, typ : typ ref}
  | ArrayTy of typ
  | ChannelTy of typ
and field_ty = FieldTy of {tag : string, typ : typ}

fun seen (stk, ty1 : typ, ty2 : typ) = let
      val x = (ty1, ty2)
      fun look [] = false
	| look (y::r) = (x = y) orelse look r
      in
	look stk
      end

(* return true if the types are "equal" *)
fun sameType (ty1, ty2) = let
      fun sameTy (AnyTy, _, _) = true
	| sameTy (_, AnyTy, _) = true
	| sameTy (BaseTy b1, BaseTy b2, _) = (b1 = b2)
	| sameTy (FunTy(t1, s1), FunTy(t2, s2), stk) =
	    sameTy(t1, t2, stk) andalso sameTy(s1, s2, stk)
	| sameTy (TupleTy tl1, TupleTy tl2, stk) = let
	    fun sameTyList ([], []) = true
	      | sameTyList (ty1::r1, ty2::r2) =
		  sameTy(ty1, ty2, stk) andalso sameTyList(r1, r2)
	    in
	      sameTyList(tl1, tl2)
	    end
	| sameTy (RecordTy fl1, RecordTy fl2, stk) = sameFieldList (fl1, fl2, stk)
	| sameTy (VariantTy fl1, VariantTy fl2, stk) = sameFieldList (fl1, fl2, stk)
	| sameTy (ty1 as RecTy{typ=ty1', ...}, ty2 as RecTy{typ=ty2', ...}, stk) =
	    (ty1' = ty2')
	    orelse seen(stk, ty1, ty2)
	    orelse sameTy(!ty1', !ty2', (ty1, ty2)::stk)
	| sameTy (ty1 as RecTy{typ, ...}, ty2, stk) =
	    seen(stk, ty1, ty2) orelse sameTy(!typ, ty2, (ty1, ty2)::stk)
	| sameTy (ty1, ty2 as RecTy{typ, ...}, stk) =
	    seen(stk, ty1, ty2) orelse sameTy(ty1, !typ, (ty1, ty2)::stk)
	| sameTy (ArrayTy ty1, ArrayTy ty2, stk) = sameTy(ty1, ty2, stk)
	| sameTy (ChannelTy ty1, ChannelTy ty2, stk) = sameTy(ty1, ty2, stk)
	| sameTy _ = false
      and sameFieldList ([], [], _) = true
	| sameFieldList (FieldTy{tag=a, typ=t}::r1, FieldTy{tag=b, typ=s}::r2, stk) =
	    (a = b) andalso sameTy(t, s, stk) andalso sameFieldList(r1, r2, stk)
	| sameFieldList _ = false
      in
	sameTy (ty1, ty2, [])
      end

(* return true, if ty1 is a subtype of ty2 *)
fun isSubtyOf (ty1, ty2) = let
      exception TypeError
    (* given two sorted lists of field types, where the second should contain all of
     * tags of the first list, return the projection of those fields from the second
     * list.
     *)
      fun projFieldList (fl1, fl2) = let
	    fun proj ([], _, l) = rev l
	      | proj (_, [], _) = raise TypeError
	      | proj (
		  l1 as (FieldTy{tag=a, ...}::r1),
		  l2 as ((f as FieldTy{tag=b, ...})::r2), l
		) = (
print(implode["proj: a = ", a, ", b = ", b, "\n"]);
		  case (StringUtil.strcmp(a, b))
		   of StringUtil.Equal => proj (r1, r2, f::l)
		    | StringUtil.GreaterTh => proj (l1, r2, l)
		    | StringUtil.LessTh => proj (r1, l2, l)
		  (* end case *))
	    in
	      proj (fl1, fl2, [])
	    end
      fun subTy (AnyTy, _, _) = true
	| subTy (_, AnyTy, _) = true
	| subTy (BaseTy b1, BaseTy b2, _) = (b1 = b2)
	| subTy (ty1 as RecTy{typ=ty1', ...}, ty2 as RecTy{typ=ty2', ...}, stk) =
	    (ty1' = ty2')
	    orelse seen(stk, ty1, ty2)
	    orelse subTy(!ty1', !ty2', (ty1, ty2)::stk)
	| subTy (ty1 as RecTy{bind, typ}, ty2, stk) =
	    seen(stk, ty1, ty2) orelse subTy(!typ, ty2, (ty1, ty2)::stk)
	| subTy (ty1, ty2 as RecTy{bind, typ}, stk) =
	    seen(stk, ty1, ty2) orelse subTy(ty1, !typ, (ty1, ty2)::stk)
	| subTy (FunTy(ty1, ty2), FunTy(ty1', ty2'), stk) =
	    subTy(ty1', ty1, stk) andalso subTy(ty2, ty2', stk)
	| subTy (TupleTy tl1, TupleTy tl2, stk) = let
	    fun subTyList ([], []) = true
	      | subTyList (t1::r1, t2::r2) =
		  subTy(t1, t2, stk) andalso subTyList(r1, r2)
	      | subTyList _ = false
	    in
	      subTyList(tl1, tl2)
	    end
	| subTy (RecordTy f1, RecordTy f2, stk) = let
	    val f1' = projFieldList (f2, f1)
	    in
	      subFieldList (f1', f2, stk)
	    end
	| subTy (VariantTy f1, VariantTy f2, stk) = let
	    val f2' = projFieldList (f1, f2)
	    in
	      subFieldList (f1, f2', stk)
	    end
	| subTy (ArrayTy ty1, ArrayTy ty2, _) = sameType(ty1, ty2)
	| subTy (ChannelTy ty1, ChannelTy ty2, _) = sameType(ty1, ty2)
	| subTy _ = false
    (* this should only be called on field lists that have the same tags *)
      and subFieldList ([], [], _) = true
	| subFieldList (FieldTy{typ=t, ...}::r1, FieldTy{typ=s, ...}::r2, stk) =
	    subTy(t, s, stk) andalso subFieldList(r1, r2, stk)
      in
	(subTy (ty1, ty2, [])) handle TypeError => false
      end

fun revApp ([], l) = l
  | revApp (x::r, l) = revApp(r, x::l)

(* Return the union of two field lists, with f mapped over their intersection. *)
fun unionFieldMap f = let
      fun union ([], [], l) = revApp (l, [])
	| union ([], l2, l) = revApp (l, l2)
	| union (l1, [], l) = revApp (l, l1)
	| union (
	    l1 as ((f1 as FieldTy{tag=a, typ=t1})::r1),
	    l2 as ((f2 as FieldTy{tag=b, typ=t2})::r2), l
	  ) = (case (StringUtil.strcmp(a, b))
	     of StringUtil.Equal =>
		  union (r1, r2, FieldTy{tag = a, typ = f(t1, t2)}::l)
	      | StringUtil.GreaterTh => union (l1, r2, f2::l)
	      | StringUtil.LessTh => union (r1, l2, f1::l)
	    (* end case *))
      in
	fn (fl1, fl2) => union (fl1, fl2, [])
      end

(* Map f over the intersection of two field lists *)
fun interFieldMap f = let
      fun inter ([], _, l) = revApp (l, [])
	| inter (_, [], l) = revApp (l, [])
	| inter (
	    l1 as (FieldTy{tag=a, typ=t1}::r1),
	    l2 as (FieldTy{tag=b, typ=t2}::r2), l
	  ) = (case (StringUtil.strcmp(a, b))
	     of StringUtil.Equal =>
		  inter (r1, r2, FieldTy{tag = a, typ = f(t1, t2)}::l)
	      | StringUtil.GreaterTh => inter (r1, l2, l)
	      | StringUtil.LessTh => inter (l1, r2, l)
	    (* end case *))
      in
	fn (fl1, fl2) => inter (fl1, fl2, [])
      end

exception Join
fun joinTy (AnyTy, _) = AnyTy
  | joinTy (_, AnyTy) = AnyTy
  | joinTy (ty as BaseTy b1, BaseTy b2) =
      if (b1 = b2) then ty else raise Join
  | joinTy (TupleTy tl1, TupleTy tl2) = let
      fun joinTyList ([], []) = []
	| joinTyList ([], _) = raise Join
	| joinTyList (_, []) = raise Join
	| joinTyList (ty1::r1, ty2::r2) = joinTy(ty1, ty2) :: joinTyList(r1, r2)
      in
	TupleTy(joinTyList (tl1, tl2))
      end
  | joinTy (FunTy(ty1, ty2), FunTy(ty1', ty2')) =
      FunTy(meetTy (ty1, ty1'), joinTy (ty2, ty2'))
  | joinTy (RecordTy fl1, RecordTy fl2) =
      RecordTy (interFieldMap joinTy (fl1, fl2))
  | joinTy (VariantTy fl1, VariantTy fl2) =
      VariantTy (unionFieldMap joinTy (fl1, fl2))
and meetTy (AnyTy, _) = AnyTy
  | meetTy (_, AnyTy) = AnyTy
  | meetTy (ty as BaseTy b1, BaseTy b2) =
      if (b1 = b2) then ty else raise Join
  | meetTy (TupleTy tl1, TupleTy tl2) = let
      fun meetTyList ([], []) = []
	| meetTyList ([], _) = raise Join
	| meetTyList (_, []) = raise Join
	| meetTyList (ty1::r1, ty2::r2) = meetTy(ty1, ty2) :: meetTyList(r1, r2)
      in
	TupleTy(meetTyList (tl1, tl2))
      end
  | meetTy (FunTy(ty1, ty2), FunTy(ty1', ty2')) =
      FunTy(joinTy (ty1, ty1'), meetTy (ty2, ty2'))
  | meetTy (RecordTy fl1, RecordTy fl2) =
      RecordTy (unionFieldMap meetTy (fl1, fl2))
  | meetTy (VariantTy fl1, VariantTy fl2) =
      VariantTy (interFieldMap meetTy (fl1, fl2))


(**** Test code ***)

fun mkRecTy (id, mkTy) = let
      val recBody = ref AnyTy
      val recTy = RecTy{bind = id, typ = recBody}
      in
	recBody := mkTy(recTy);
	recTy
      end
fun mkVar1 (tag, ty) = VariantTy[FieldTy{tag = tag, typ = ty}]
val unitTy = BaseTy UnitTy
val intTy = BaseTy IntTy

(* rec (t) [nil : Unit, cons : {hd : Int, tl : t}] *)
val intListTy = mkRecTy("t",
      fn recTy => VariantTy[
              FieldTy{tag = "nil", typ = unitTy},
              FieldTy{tag = "cons", typ = RecordTy[
                  FieldTy{tag = "hd", typ = intTy},
                  FieldTy{tag = "tl", typ = recTy}
                ]}
            ])

(* [cons : {hd : Int, tl : [nil : Unit]}] *)
val intListTy' = VariantTy[
        FieldTy{tag = "cons", typ = RecordTy[
            FieldTy{tag = "hd", typ = intTy},
            FieldTy{tag = "tl", typ = VariantTy[
		FieldTy{tag = "nil", typ = unitTy}
	      ]}
          ]}
      ]
====
The following shorter example causes an uncaught subscript in 0.77 & 0.78 (but
not in 0.77b):

  datatype tree = Leaf of int | Plus of (tree * tree * int);
  (Plus (Leaf 0,Leaf 1,2),2);

for example:

  Standard ML of New Jersey, Version 0.78, February 26, 1992
  Arrays have changed; see Release Notes
  val it = () : unit
  - datatype tree = Leaf of int | Plus of (tree * tree * int);
  datatype  tree
  con Leaf : int -> tree
  con Plus : tree * tree * int -> tree
  - (Plus (Leaf 0,Leaf 1,2),2);
  val it = (Plus (
  uncaught exception Subscript
  - 
Comment: 
  Bug appeared between 0.77b and 0.77.  Possibly related to change
  in dataconstructor representations.

>Submitter:      Andrzej Filinski <andrzej@cs.cmu.edu>
>Date:		March 19, 1992
>Version:        0.78
>System:         All
>Severity:       Major
>Problem:        Printing certain datatype values raises Subscript
>Transcript:     Standard ML of New Jersey, Version 0.78, February 26, 1992
		Arrays have changed; see Release Notes
		val it = () : unit
		- datatype foo = BAR of int | BAZ of foo * foo;
		datatype  foo
		con BAR : int -> foo
		con BAZ : foo * foo -> foo
		- BAZ (BAR 1, BAR 2);
		val it = BAZ (
		uncaught exception Subscript
		-
  [Bob Harper, 4/10/92]:
  Dave Tarditi suggested that the constructor printing problem might be due to
  the fact that something or other got reversed in the code generator, but this
  was forgotten in the print routines.  Apparently some representation is now
  done in reverse order.

  I consistently get the following behavior:
  1. Build a system using SourceGroup.make.
  2. Open a particular structure, making available a constructor Abs (among
     many others).
  3. Modify things, do another make.
  4. Uses of Abs suddenly get weird type errors.  Typing Abs at top level
     results in "val it = exn : exn".

  I could send the whole system, but this seems excessive....
Status: fixed in 0.84
----------------------------------------------------------------------
Number: 528
Title: Compiler bug: ModuleUtil.teststr 2
Keywords: 
Submitter:      Ian Green, aisb@ed.ac.uk
Date:		3/18/92
Version:        0.75
System:         Sun SPARC 1+, SunOS 4.1
Severity:       john major
Problem:        Error: Compiler bug: ModuleUtil.teststr 2
Code:           

************ UnifyFUN.sml *************
import "TermsSIG";
import "UnifySIG";

functor Unifier(structure Terms:TERMS):UNIFY = 
    struct
	local
	    open Terms
	    fun unifyst _ _ _ = []
	in
	    fun mgu t1 t2 = unifyst [] [(t1,t2)] []
		handle No_Unifier => []
	end
    end
****************************************

************ UnifySIG.sml **************
import "TermsSIG";

signature UNIFY =
    sig
	local
	    structure Terms:TERMS
	    open Terms
	in
	    val mgu : Terms.term -> Terms.term -> (Terms.atom * Terms.term) list
	end
    end
*****************************************

********** TermsSIG.sml ***************
signature TERMS =
    sig
	datatype atom = Var of string 
	  |  Const of string
	datatype term =
	    Atomic of atom
	  | Term of atom * term list
	  | WhereTerm of atom list * term * term;
	val subst : atom list -> (atom * term) list -> term -> term
    end;
****************************************
    
************ TermsFUN.sml *************
import "TermsSIG";

functor Terms( ):TERMS =
    struct
	datatype atom = Var of string 
	  |  Const of string
	datatype term =
	    Atomic of atom
	  | Term of atom * term list
	  | WhereTerm of atom list * term * term;
	fun subst _ _ t = t (* i like this case *)
    end;
****************************************

************ load ******************
import "TermsFUN";
import "UnifyFUN";

structure Term = Terms( );

structure Unify = Unifier(structure Terms = Term);
****************************************

Transcript: 

In summary, I do three `use "load"' starting with no bin files.  The
first gives no error, but i get <erro> types (what does that mean).
Second time a recompile is needed (odd?) and get a Compiler bug:

On the third try, no recompile needed, but get same compiler bug
report.  Here it is in all its (gory) detail. 
---------------------------------------------------------
Standard ML of New Jersey, Version 75, November 11, 1991
Arrays have changed; see Release Notes
val it = () : unit
- use "load";
[opening load]
[reading TermsFUN.sml]
  [reading TermsSIG.sml]
  [writing TermsSIG.bin... done]
  [closing TermsSIG.sml]
[writing TermsFUN.bin... done]
[closing TermsFUN.sml]
functor Terms
signature TERMS
[reading UnifyFUN.sml]
  [reading TermsSIG.bin... done]
  [reading UnifySIG.sml]
    [reading TermsSIG.bin... done]
UnifySIG.sml:6.6-8.1 Warning: LOCAL specs are only partially implemented
  [writing UnifySIG.bin... done]
  [closing UnifySIG.sml]
[writing UnifyFUN.bin... done]
[closing UnifyFUN.sml]
functor Unifier
signature UNIFY
signature TERMS
structure Term :
  sig
    datatype atom
      con Const : string -> atom
      con Var : string -> atom
    datatype term
      con Atomic : atom -> term
      con Term : atom * term list -> term
      con WhereTerm : atom list * term * term -> term
    val subst : atom list -> (atom * term) list -> term -> term
  end

structure Unify : UNIFY
[closing load]
val it = () : unit
- Unify.mgu;
val it = fn : <error> -> <error> -> (<error> * <error>) list
- use "load";
[opening load]
[reading TermsFUN.bin... ]
[import(s) of TermsFUN are out of date; recompiling]
[closing TermsFUN.bin]
[reading TermsFUN.sml]
  [reading TermsSIG.bin... done]
[writing TermsFUN.bin... done]
[closing TermsFUN.sml]
functor Terms
signature TERMS
[reading UnifyFUN.bin... done]
functor Unifier
signature UNIFY
signature TERMS
structure Term :
  sig
    datatype atom
      con Const : string -> atom
      con Var : string -> atom
    datatype term
      con Atomic : atom -> term
      con Term : atom * term list -> term
      con WhereTerm : atom list * term * term -> term
    val subst : atom list -> (atom * term) list -> term -> term
  end

Error: Compiler bug: ModuleUtil.teststr 2
[closing load]
- use "load";
[opening load]
[reading TermsFUN.bin... done]
functor Terms
signature TERMS
[reading UnifyFUN.bin... done]
functor Unifier
signature UNIFY
signature TERMS
structure Term :
  sig
    datatype atom
      con Const : string -> atom
      con Var : string -> atom
    datatype term
      con Atomic : atom -> term
      con Term : atom * term list -> term
      con WhereTerm : atom list * term * term -> term
    val subst : atom list -> (atom * term) list -> term -> term
  end

Error: Compiler bug: ModuleUtil.teststr 2
[closing load]
-

Comments:  I see from the compiler that LOCAL specs are only partially
implemented, so this is probably the cause, though i dont get the
<error> bit.  As I am new to modules in ML, its all probably
meaningless code anyway, but I thought I ought to drop you a line.

Status: not a bug --- cannot reproduce (bug report incomplete); probably fixed.
----------------------------------------------------------------------
Number: 529
Title: memory leak
Keywords: 
Submitter: schristensen@daimi.aau.dk (Soren Christensen)
Date: 3/20/92
Version: 0.75
Severity: major
Problem: 
  I have a problem that my system slows down after running a short while.
  Instead of using the ordinary top-loop of the compiler I run my own. This
  means that I evaluate ML code in the following way:

  use_stream (open_string "code");

  It seems that this construct creates 16 bytes of "garbage" which is never
  collected.

  My first idea was that I needed to close the stream which is created, i.e.,

  let
    val is = open_string "code"
  in
   use_stream is;
   close_in is
  end;

  But this does not fix the problem.

  It seems that "close_in is" have no effect. At least it reports no errors
  when a use_string is performed on a stream which has been closed.

Status: fixed in 0.84
----------------------------------------------------------------------
Number: 530
Title: missing space in printing abstype declaration
Keywords: 
Submitter:      Mikael Pettersson, mpe@ida.liu.se
Date:           3/20/92
Version:        0.75
System:         all
Severity:       minor
Problem:        when printing a polymorphic abstype, no space is inserted
                between the "type" symbol and the type variable
Transcript:

- abstype 'a foo = FOO of 'a list
= with
=   fun mkfoo() = FOO []
= end;
type'a  foo		(* note: missing space after "type" *)
val mkfoo = fn : unit -> 'a foo

Fix:

--cut here--
*** src/print/printdec.sml.~1~	Fri Oct 18 23:21:13 1991
--- src/print/printdec.sml	Fri Mar 20 14:00:07 1992
***************
*** 50,56 ****
  	     printSym name; print " = "; printType env def; newline())
  
  	and printAbsTyc(GENtyc{path=name::_, arity, eq, kind=ref(ABStyc _), ...}) =
! 	    (print(if (!eq=YES) then "eqtype" else "type"); 
  	     printFormals arity; print " ";
  	     printSym name; newline())
  
--- 50,56 ----
  	     printSym name; print " = "; printType env def; newline())
  
  	and printAbsTyc(GENtyc{path=name::_, arity, eq, kind=ref(ABStyc _), ...}) =
! 	    (print(if (!eq=YES) then "eqtype " else "type "); 
  	     printFormals arity; print " ";
  	     printSym name; newline())
  
--cut here--
Status: fixed in 0.86
----------------------------------------------------------------------
Number: 531
Title: Compiler bug: CoreLang.makeOVERLOADdec.option
Keywords: 
Submitter: John Reppy
Date: 3/24/92
Version: 0.78
Severity: major
Problem: 
  I noticed a "CoreLang.makeOVERLOADdec.option"
  compiler bug (this also occurs in 0.78):
Transcript: 
  <jhr@bat> cat boot/perv.sml
  structure Foo = struct
    val x = InLine.:=
  end
  <jhr@bat> smlc
  Standard ML of New Jersey, Version 0.78, February 26, 1992 (batch compiler)
  ~mBoot
  [mBoot()]
   ...
  [Compiling boot/perv.sml]
  structure Foo : ...
  [closing boot/perv.sml]
  boot/overloads.sml:4.15-4.21 Error: unbound structure Initial
  boot/overloads.sml:6.7-6.21 Error: unbound structure Bool in path Bool.makestring
  boot/overloads.sml:6.27-6.44 Error: unbound structure Integer in path Integer.makestring
  boot/overloads.sml:6.50-6.64 Error: unbound structure Real in path Real.makestring
  Error: Compiler bug: CoreLang.makeOVERLOADdec.option
  [closing boot/overloads.sml]
  [Failed on "~mBoot" with Syntax]
Comment: [dbm]
  This should never be visible to a user.
Status: not a bug
----------------------------------------------------------------------
Number: 532
Title: squaring big real number dumps core on sparc (see also 638)
Keywords: 
Submitter: rst@ai.mit.edu (Robert S. Thau)
Date: 3/24/92
Version: ?
System: Sparc
Severity: 
Problem: 
  To repeat this, just attempt to square 1.0E~160 on your nearest sparcstation
  in SML/NJ.  The process will die, complaining that "underflow should not trap".
Fix:
  As I read the source code, the machine-independant signal-handling code (in
  signal.c) expects floating point underflows not to trap, but the machine-
  dependant code does enable underflow trapping.  Accordingly, here's a
  one-line fix to SPARC.dep.c in the runtime directory:

  *** SPARC.dep.c	Tue Mar 24 18:08:57 1992
  --- SPARC.dep.c.~1~	Tue Aug 20 12:03:52 1991
  ***************
  *** 108,112 ****
	SETSIG (SIGILL, fpe_handler, mask);
    #endif MACH

  !     set_fsr (0x0d000000); /* enable FP exceptions NV, OF & DZ; disable UF */
    }
  --- 108,112 ----
	SETSIG (SIGILL, fpe_handler, mask);
    #endif MACH

  !     set_fsr (0x0f000000); /* enable FP exceptions NV, OF, UF & DZ */
    }
Status: fixed in 0.90
----------------------------------------------------------------------
Number: 533
Title: typing record types
Keywords: 
Submitter:      Richard O'Neill <richard@smaug.questor.wimsey.bc.ca>
Date:		3/24/92
Version:        0.75 (and 0.73, don't know about 0.78)
System:         NeXTstation, OS2.1 & Sun4 SunOS 4.1.1.
Severity:       Major
Problem:        


The type system is *broken* w.r.t. record types. The problem is tied in
with use of flex records (but I do NOT mean the 'unresolved flex record
in let pattern' business that novice programmers sometimes fail to
understand).  The type checker gives an incorrect (too general) typing
for valid SML.  A very minor change causes a correct typing to be given.

The best way to show this bug is to give some code that reproduces it:

   (*
    * The compiler incorrectly types this function as:
    * {key:''a,value:'b} list -> {key:''a,value:'c} -> {key:''a,value:'b} list
    * 						 ^--- should be 'b
    *)
    

    fun insert1 alist (item as {key=desired, ...}) =
	let				  (* ^--- remember this bit *)
	    fun worker nil = item :: nil
	      | worker ({key,value} :: items) =
		if key = desired then
		    item :: items
		else
		    worker items
	in
	    (worker alist)
	end

   (*
    * The compiler correctly types this function as:
    * {key:''a,value:'b} list -> {key:''a,value:'b} -> {key:''a,value:'b} list
    * 						 ^--- correct
    *)
    

    fun insert2 alist (item as {key=desired, value = _}) =
	let				  (* ^--- the only difference *)
	    fun worker nil = item :: nil
	      | worker ({key,value} :: items) =
		if key = desired then
		    item :: items
		else
		    worker items
	in
	    (worker alist)
	end


Transcript:

unix% sml
Standard ML of New Jersey, Version 75, November 11, 1991
Arrays have changed; see Release Notes
val it = () : unit
- use "typing-bug.sml"	(* Just the source as shown above... *);
[opening typing-bug.sml]
val insert1 = fn : {key:''a,value:'b} list -> {key:''a,value:'c} -> {key:''a,value:'b} list
val insert2 = fn : {key:''a,value:'b} list -> {key:''a,value:'b} -> {key:''a,value:'b} list
[closing typing-bug.sml]
val it = () : unit
- val [{value=foo, ...}] = insert1 nil {key=17, value=100}	(* broken *)
= and [{value=bar, ...}] = insert2 nil {key=17, value=100}	(* okay   *) ;
std_in:3.1-4.56 Warning: binding not exhaustive
        {value=bar,...} :: nil = ...
std_in:3.1-4.56 Warning: binding not exhaustive
        {value=foo,...} :: nil = ...
val foo = - : 'a
val bar = 100 : int
- foo : int;
val it = 100 : int
- foo : string;
val it = "d" : string
- foo : real;			(* This one's cruel, I know... *)
Bus error (core dumped)
unix%
Comment:
  In practice, it isn't to much of a problem as one can always restrict
  the type or use the form that types correctly. Even so, it does reflect
  a problem in the type checker and ought to be fixed.
Status: fixed in 0.85
----------------------------------------------------------------------
Number: 534
Title: .bin files for share and noshare compiler incompatible
Keywords: 
Submitter: Bernard Sufrin
Date: 3/24/92
Version: 0.75
System: Sparc/SUNOS 4.1.1
Severity: minor
Problem: 
  I have a good deal of evidence that .bin files compiled by the shared
  compiler and those compiled by the unshared compiler are incompatible.
  Shared compiler generated .bin files cause the unshared compiler
  to crash with a bus error, and vice versa.
Status: fixed in 0.95
----------------------------------------------------------------------
Number: 535
Title: Problems with non-equality types (bug or language problem?) (see also 341)
Keywords: 
Submitter:      Richard O'Neill <richard@smaug.questor.wimsey.bc.ca>
Date:		3/25/92
Version:        0.75 (and 0.73, don't know about 0.78)
System:         NeXTstation, OS2.1 & Sun4 SunOS 4.1.1.
Severity:       Major
Problem:        

I'm not sure if this is a bug or a language 'feature' - whatever it is,
it is certainly unnecessarily restrictive and needs fixing...

If I have a reference to a type that does not admit equality, I can
still test  *references* to that type for equality. But, if that reference
is wrapped up as part of a structured type, I cannot.

It isn't necessarily tied to references. It also applies to any parametric
types which don't actually contain an element of the type, such as:
	datatype 'a type_only = TypeOnly

Take a look at the transcript below...

Transcript:

Standard ML of New Jersey, Version 75, November 11, 1991
Arrays have changed; see Release Notes
val it = () : unit
- abstype abstract = Abstract with val abstract = Abstract end;
type abstract
val abstract = - : abstract
- val abstract_ref = ref abstract;
val abstract_ref = ref - : abstract ref
- abstract_ref = abstract_ref;
val it = true : bool
-
- datatype 'a wrapped_ref = WrappedRef of 'a ref;
datatype 'a  wrapped_ref
con WrappedRef : 'a ref -> 'a wrapped_ref
- val wrapped_abstract_ref = WrappedRef (abstract_ref);
val wrapped_abstract_ref = WrappedRef (ref -) : abstract wrapped_ref
- wrapped_abstract_ref = wrapped_abstract_ref;
std_in:7.1-7.43 Error: operator and operand don't agree (equality type required)
  operator domain: ''Z * ''Z
  operand:         abstract wrapped_ref * abstract wrapped_ref
  in expression:
    = (wrapped_abstract_ref,wrapped_abstract_ref)
- 

- datatype 'a type_only = TypeOnly;
datatype 'a  type_only
con TypeOnly : 'a type_only
- fun equal (x as TypeOnly, y as TypeOnly) = x = y;
val equal = fn : ''a type_only * ''a type_only -> bool
- (*             ^--- doesn't really have to be an equality type *)
- 
Status: not a bug (language problem)
----------------------------------------------------------------------
Number: 536
Title: twig out of date
Keywords: 
Submitter: wgehrke@risc.uni-linz.ac.at (Wolfgang Gehrke)
Date: 3/26/92
Version: 0.75
Problem: 
  I had a small trouble to use twig together with this version of ML.
  There were two problems:

  1) The generated code contains identifiers beginning with '_'.

  2) I also changed "invoke.sml" to get a stand alone version.
Status: fixed in 0.90
----------------------------------------------------------------------
Number: 537
Title: System.system fails in noshare compiler after Heap extension
Keywords: 
Submitter: Eric Madelaine <Eric.Madelaine@sophia.inria.fr>
Date: 3/26/92
Version: 0.75
System: sparc
Severity: major
Problem: 
  When using an sml "-noshare" system, 
  and after the first "Heap extension",
  any call to System.system fails with:

	  uncaught exception SystemCall

  This error does not occur before having the heap extended, nor in
  a system built without the "-noshare" option, even after many heap
  extensions.
  [followup on 3/31/92]:
  It occurs now in any configuration of my system (may be because it is
  bigger now).
Status: fixed in 0.84
----------------------------------------------------------------------
Number: 538
Title: uncaught exception subscript during compilation
Keywords: 
Submitter: Dave MacQueen
Date: 3/30/92
Version: 0.78
Problem: 
Code: 
(* hacked version of code from David Ladd *)
(* Variables provide a more sophisticated and better packaged version
of ID's *)

signature VARIABLES =
sig
  datatype var  (* variables *)
   = PREVBL of string
   | VBL of {name: string, stamp: int}
  val varname : var -> string
  (* following are concerned with "alpha conversion" *)
  type varenv
  val newvar: string -> var
  val empty_env : varenv
  val lookup : varenv * string -> var option
  val bind : string * var * varenv -> varenv
end

structure Variables: VARIABLES =
struct
(* Rather than represent variables as simple strings, I introduce
   a variable type (var).  The first form (PREVBL) is a temporary variable
   produced on parsing, and then replaced when static analysis is performed
   to determine scoping and association between binding and applied occurences
   of variables.  If parsing is made a bit more complicated, this static
   analysis can be done on the fly during parsing and only the second form
   of variable would be needed (this is how it is currently done in the ML
   compiler.  For the VBL form, the stamp field is an integer that uniquely
   identifies that variable.
*)
  datatype var  (* variables *)
   = PREVBL of string
   | VBL of {name: string, stamp: int}

  fun varname(PREVBL s) = s
    | varname(VBL{name,stamp}) = name ^ "." ^ makestring stamp

  val count = ref 0

  fun newvar s = VBL{name=s, stamp=(inc count; !count)}

  type varenv = (string * var) list

  val empty_env = []

  fun lookup([],_) = NONE
    | lookup((s,v)::rest,s') = if s = s' then SOME v else lookup(rest,s')

  fun bind(s,v,env) = (s,v)::env
end (* structure Variables *)


(* it will probably be more convenient to have a smaller number of
   cases in the expression datatype.  One way of reducing the number
   of expression constructs is to have an APP constructor that takes
   an "operator" and a list of argument expressions.  If the set of
   possible operators is fixed, then they may be defined as the
   constructors of an operator datatype, as below.  If new operators
   can be introduced, then a more complicated operator type would be
   appropriate.  You might look at src/absyn/bareabsyn.sml to see how
   the ML abstract syntax is defined.

   Each operator needs to be assigned its arity, and when constructing
   an expression, or when checking its "well-formedness" (a mild form
   of type checking), one would verify that the length of the argument
   list matches the arity of the operator.

   For proper type checking, each operator would be assigned a type,
   which would presumably subsume its arity.
*)

structure Operators =
struct
  datatype operator
   = PLUS
   | MINUS
   | MUL
   | DIV
   | MOD
   | EXP
   | SHL
   | SHR
   | BAND
   | BOR
   | XOR
   | EQ
   | NEQ
   | GT
   | LT
   | GTE
   | LTE
   | AND
   | OR
   | IS_IN
   | UNION
   | INTERSECTION
   | SUBSE
   | SET_EQ
   | SET_MINUS
   | MATCH
   | NOT_MATCH
   | UMINUS
   | NOT
   | BNOT
   | COUNT
   | MIN
   | MAX
   | SUM

  (* following function is useful for printing expressions, as in ppexpr *)
  fun operName PLUS = "plus"
    | operName MINUS = "minus"
    | operName MUL = "mul"
    | operName DIV = "div"
    | operName MOD = "mod"
    | operName EXP = "exp"
    | operName SHL = "shl"
    | operName SHR = "shr"
    | operName BAND = "band"
    | operName BOR = "bor"
    | operName XOR = "xor"
    | operName EQ = "eq"
    | operName NEQ = "neq"
    | operName GT = "gt"
    | operName LT = "lt"
    | operName GTE = "gte"
    | operName LTE = "lte"
    | operName AND = "and"
    | operName OR = "or"
    | operName IS_IN = "is_in"
    | operName UNION = "union"
    | operName INTERSECTION = "intersection"
    | operName SUBSE = "subse"
    | operName SET_EQ = "set_eq"
    | operName SET_MINUS = "set_minus"
    | operName MATCH = "match"
    | operName NOT_MATCH = "not_match"
    | operName UMINUS = "uminus"
    | operName NOT = "not"
    | operName BNOT = "bnot"
    | operName COUNT = "count"
    | operName MIN = "min"
    | operName MAX = "max"
    | operName SUM = "sum"

  fun arity(oper: operator) : int =
      case oper
	of UMINUS => 1
	 | NOT => 1
	 | BNOT => 1
	 | COUNT => 1
	 | MIN => 1
	 | MAX => 1
	 | SUM => 1
	 | _ => 2

end (* structure Operators *)

open Variables Operators

(* the rest of this should be packaged in structures too, but its getting
   late so I'm not going to finish it. *)

datatype exp
 = INT of int  		(* was CONST *)
 | STR of string
 | ENUM of string	(* probably want something more specialized than string *)
 | VAR of var  		(* was ID *)
 | QUES of exp * exp * exp
 | SET of exp list
 | APP of operator * exp list

(* val test = PLUS(CONST(4),CONST(3)); *)
val test = APP(PLUS,[INT 4, INT 3])

datatype stmt
 = ASSERT of exp
 | FOR of var * exp * stmt
 | CMPD of stmt list;

val testprog = FOR(PREVBL "x",SET([INT(1),INT(2)]),
		ASSERT(APP(EQ,[VAR(PREVBL "x"),INT 0])));

val testprog2 = FOR(PREVBL "x",
		    SET([INT 1, INT 2]),
		    CMPD([
			  ASSERT(APP(EQ,[VAR(PREVBL "x"),INT 0])),
			  FOR(PREVBL "x",
			      SET([INT(3),INT(4)]),
			      ASSERT(APP(NEQ,[VAR(PREVBL "x"),INT 1]))
			      ),
			  ASSERT(APP(NEQ,[VAR(PREVBL "x"),INT 1]))
			  ])
		    );

(* for some useful printing utilities, you might look at 
   src/basics/printutil.sml in the ML source code.  But much more
   sophisticated pretty-printing support is likely to become available soon.
*)

(* all this concatenating of strings (in a quadratic fashion), is liable
   to get expensive if you start printing big objects.  It is probably
   more efficient to print directly rather than build a string.  There
   will be an sprintf-style facility in the new library we are building,
   so you could print "into" a string in a linear fashion.
*)

(* in src/absyn/printabsyn.sml you can find our rather crude 
   pretty printer for ML abstract syntax.  It attempts to cope
   with infix operators and their precedences and other complications.
*)

fun prvar (PREVBL s) = s
  | prvar (VBL{name,stamp}) = name ^ "." ^ makestring stamp

fun ppexpr (APP(EQ,[a,b])) = ppexpr a ^" == "^ ppexpr b
  | ppexpr (APP(NEQ,[a,b])) = ppexpr a ^" != "^ ppexpr b
  | ppexpr (INT i) = makestring i
  | ppexpr (STR s) = "\"" ^ s ^ "\""
  | ppexpr (VAR v) = prvar v
  | ppexpr (SET l) = "{" ^ pplist l ^ "}"
  | ppexpr (QUES(e1,e2,e3)) =
     "if " ^ ppexpr e1 ^ " then " ^ ppexpr e2 ^ " else " ^ ppexpr e3
  | ppexpr (APP(oper,args)) =
     operName oper ^ "(" ^ pplist args ^ ")"
     (* here you see the advantage of separating out the operators *)

and pplist ([h]) = ppexpr h   (* shorthand for h::[] *)
  | pplist (h::t) = ppexpr h ^ "," ^ pplist t 
  | pplist [] = "" 

(* this could be made a bit more efficient.  We probably need to provide
   a primitive to efficiently build such strings.
fun sp 0 = ""
  | sp n = " " ^ sp (n - 1);
Below is a somewhat faster version (especially as n gets larger.
*)

fun sp n =
    let fun collect(0,l) = l
	  | collect(n,l) = collect(n-1," "::l)
     in implode(collect(n,[]))
    end

fun ppstmt (t,ASSERT(x)) = "\n" ^ sp t ^ ppexpr x ^ ";"
  | ppstmt (t,FOR(a,b,c)) = 
      "\n"^ sp t ^"for " ^ (varname a) ^ " in " ^ ppexpr b ^ ppstmt(t+1,c)
  | ppstmt (t,CMPD(nil)) = ""
  | ppstmt (tab,CMPD(l)) = 
    let fun pplist (h::t) = ppstmt(tab,h) ^ pplist t
	  | pplist [] = "" 
    in 
	" begin" ^ pplist l ^ "\n" ^ sp (tab - 1) ^ "end"
    end;
    
fun prt (ex) = output(std_out,ppstmt(0,ex) ^ "\n");


(* to complete this evaluator sensibly you need a more general notion of
   the values that your expressions can evaluate to.  Presumably you
   need to deal with strings, booleans, and set values in addition
   to integers.  The value type will probably be a datatype. *)

datatype value
 = INTval of int
 | STRval of string
 | BOOLval of bool
 | SETval of value list  (* allows heterogeneous sets, which probably
			    don't occur. *)

fun seval (INT x) = INTval x
  | seval (APP(PLUS,[a,b])) =
     let val INTval va = seval a and INTval vb = seval b
      in INTval(va+vb)
     end
  | seval (APP(MINUS,[a,b])) =
     let val INTval va = seval a and INTval vb = seval b
      in INTval(va-vb)
     end
  | seval (QUES(x,y,z)) = 
     let val INTval vx = seval x and INTval vy = seval y and INTval vz = seval z
      in INTval(if vx <> 0 then vy else vz)
     end
  | seval (_) = INTval 0; (* ??? *)
    
(* what types of values does an operator like EQ apply to?  If it is
overloaded, and can apply to, say, integers and strings, then the
evaluation rule has to do a case analysis:

  | seval (APP(EQ,[a,b])) =
    case seval a
      of INTval va =>
	  (case seval b
	     of INTval vb => BOOLval(va = vb)
	      | _ => raise TypeError)
       | STRval va =>
	  (case seval b
	     of STRval vb => BOOLval(va = vb)
	      | _ => raise TypeError)
       | ...
*)


fun eaconv env (e as VAR(PREVBL x)) = 
     (case lookup(env,x)
       of SOME v => VAR v
        | NONE => e)
  | eaconv env (APP(oper,args)) = APP(oper, map (eaconv env) args)
  | eaconv env (QUES(e1,e2,e3)) = QUES(eaconv env e1, eaconv env e2, eaconv env e3)
  | eaconv env (SET elems) = SET(map (eaconv env) elems)
  | eaconv env e = e
    
fun alphasub (env,ASSERT(x)) = ASSERT(eaconv env x)
  | alphasub (env,CMPD(l)) =
      let fun mapped(x) = alphasub(env,x)
       in CMPD(map mapped l)
      end
  | alphasub (env,FOR(PREVBL a, b, c)) = 
      let val new = newvar a
       in FOR(new, (eaconv env b), alphasub( bind(a,new,env), c))
      end
  | alphasub (env,stmt) = stmt;

fun aconv(x) = alphasub(empty_env,x);

Status: fixed in 0.83
----------------------------------------------------------------------
Number: 539
Title: weak typing bug
Keywords: 
Submitter: John Greiner
Date: 4/2/92
Version: 0.75
Severity: major
Problem: 
  weak typing failure
Transcript: 
- (let val x = ref nil in fn y => x end) ();
val it = ref [] : '1a list ref

- let val a = (let val x = ref nil in fn y => x end) () in
= a:=[1]; hd(!a)^"hi" end;
val it = "\^Ahi" : string

In V.73 (I think) this wasn't there, as I have referenced in a file:
- (let val x = ref nil in fn y => x end) ();
std_in:2.1-2.41 Error: nongeneric weak type variable
  it : '~1Z list ref

Status: fixed in 0.89
----------------------------------------------------------------------
Number: 540
Title: printing hanging on Mach
Keywords: 
Submitter: Bob Harper
Date: 4/2/92
Version: 0.78
System: DecStation 5000, Mach, running over telnet
Severity: major
Problem: 
  Type "structure S = System".
  On my machine it prints about halfway through, then hangs.
Comment:
  Sometimes when running sml over a telnet, the printing hangs.  You can
  continue by typing space.  This is not new to 0.78. [Gene Rollins]

  [Bob Harper, 4/11/92]:
  Incidentally, on the PMAX (at least) I consistently get the following
  behavior.  I type in something, particularly something that incurs a type
  error.  I get back half or three quarters of a message, then it hangs.  The
  only way out is to type ^C, which gets me back to the prompt.  If I type the
  same thing again, I may or may not get the full message.  Often I just kill
  the session and start over, then it works (for a while).  We're running Mach
  on the PMAX, and I'm using ML via telnet, within an emacs ML interaction
  window, if it matters.
Status: fixed in 0.84
----------------------------------------------------------------------
Number: 541
Title: warnings while compiling runtime
Keywords: 
Submitter:      Kai Kein{nen <kmk@cc.tut.fi>
Date:		4/5/92
Version:        0.80 from research.att.com:/dist/ml/working on April 5
System:         RISC/OS 4.52, MIPS RC 6280
Severity:       minor
Problem:        compilation time warnings for gc.c and prim.s
Code:           ./makeml -mips riscos
Transcript:     

./makeml> (cd runtime; make clean)
	rm -f *.o lint.out prim.s linkdata allmo.s run
./makeml> rm -f mo
./makeml> ln -s ../mo.mipsb mo
./makeml> (cd runtime; rm -f run allmo.o allmo.s)
./makeml> (cd runtime; make MACHINE=MIPS  'CFL= -systype bsd43' 'LIBS=' 'DEFS= -DRISCos -DRUNTIME=\"runtime\"' linkdata)
	cc -O -systype bsd43 -DMIPS -DRISCos -DRUNTIME=\"runtime\" -o linkdata linkdata.c
./makeml> runtime/linkdata [runtime/IntMipsBig.mos]
runtime/linkdata> as runtime/allmo.s -o runtime/allmo.o
./makeml> (cd runtime; make  MACHINE=MIPS 'DEFS= -DRISCos' 'CPP=/lib/cpp -P' 'CFL= -systype bsd43' 'AS=as' 'LIBS=')
	cc -O -systype bsd43 -DMIPS -DRISCos -c run.c
	cc -O -systype bsd43 -DMIPS -DRISCos -c run_ml.c
	cc -O -systype bsd43 -DMIPS -DRISCos -c callgc.c
	cc -O -systype bsd43 -DMIPS -DRISCos -c gc.c

uopt: Warning: gc: this procedure not optimized because it
      exceeds size threshold; to optimize this procedure, use -Olimit option
      with value >=  886.
	cc -O -systype bsd43 -DMIPS -DRISCos -c MIPS.dep.c
	cc -O -systype bsd43 -DMIPS -DRISCos -c export.c
	cc -O -systype bsd43 -DMIPS -DRISCos -c timers.c
	cc -O -systype bsd43 -DMIPS -DRISCos -c ml_objects.c
	cc -O -systype bsd43 -DMIPS -DRISCos -c cfuns.c
	cc -O -systype bsd43 -DMIPS -DRISCos -c cstruct.c
	cc -O -systype bsd43 -DMIPS -DRISCos -c signal.c
	cc -O -systype bsd43 -DMIPS -DRISCos -c exncode.c
	cc -O -systype bsd43 -DMIPS -DRISCos -c malloc.c
	cc -O -systype bsd43 -DMIPS -DRISCos -c mp.c
	cc -O -systype bsd43 -DMIPS -DRISCos -c sync.c
	/lib/cpp -P -DASM -DMIPS -DRISCos MIPS.prim.s > prim.s
	as -o prim.o prim.s
as0: Warning: prim.s, line 305: missing .end preceding this .ent: set_request
      .ent set_request
as0: Warning: prim.s, line 305: .ent/.end block never defined the procedure name
as0: Warning: prim.s, line 434: missing .end preceding this .ent: go
      .ent go

Comments:
Some of the corrections needed earlier for MIPS R6000 seem to be
missing from this version.
The interpreter seems to work correctly in spite of these warnings.

Status: fixed in 0.90
----------------------------------------------------------------------
Number: 542
Title: lack of environment cleanup in 0.80
Keywords: 
Submitter: schristensen@daimi.aau.dk (Soren Christensen)
Date: 4/6/92
Version: 0.80
Severity: major
Problem: 
  The other question is related to a problem I had in 0.75:
  >fun x 0 = () | x n = (use_stream (open_string "3"); x (n-1));
  >fun test () = (exportML "pre"; x 1000; exportML "post");
  >
  >Try test(); and check the diff in size of pre and post.

  There seems to be a more grneral problem in 0.80. The toplevel environment
  seems to grow - even if I do not declare new names. Now that I can inspect
  the valuse in the environmet I find "VAL$it" repeted.
  try:
   map (fn x => print (System.Symbol.makestring x))(System.Env.catalogEnv
  (System.Env.staticPart (!System.Env.topLevelEnvRef)));

  Especially after running for a while.
Status: fixed in 0.82
----------------------------------------------------------------------
Number: 543
Title: top-level printing fails
Keywords: 
Submitter: Bob Harper
Date: 4/8/92
Version: ?
Severity: major
Problem: 
Code: 
    type OrdId = string
    type ModId = string

    datatype Ord =
	Kind
      | Type
      | Pi of Dec * Ord
      | Abs of Dec * Ord
      | App of Ord * Ord
      | Cast of Ord * Ord
      | One
      | Sub of Ord * Sub
      | Fst of Mod

    and Mod =
        KindM
      | Signature
      | PiM of DecM * Mod
      | AbsM of DecM * Mod
      | AppM of Mod * Mod
      | OneM
      | CastM of Mod * Mod
      | SubM of Mod * Sub
      | Nil
      | NilSig
      | OTuple of Def * Mod
      | OTupleSig of Dec * Mod
      | RTuple of DefM * Mod
      | RTupleSig of DecM * Mod
      | FstM of Mod
      | SndM of Mod

    and Sub =
	Id
      | Shift
      | ODef of Sub * (OrdId * Ord * Ord option)
      | MDef of Sub * (ModId * Mod * Mod option)
      | Comp of Sub * Sub

    and Ctx =
	Null
      | ODec of Ctx * Dec
      | MDec of Ctx * DecM

    and Dec = Dec of OrdId * Ord
    and Def = Def of OrdId * Ord

    and DecM = DecM of ModId * Mod
    and DefM = DefM of ModId * Mod ;
Transcript: 
  I type:

  val S = OTupleSig(Dec("t",Type),NilSIg);

  I get:

  val S = OTupleSig (
  uncaught exception Subscript

  The actual input is much larger: I build the system using SourceGroup, then
  open the structure IntSyn, which makes available this datatype, which then
  results in the exhibited behavior.
Status: fixed in 0.84
----------------------------------------------------------------------
Number: 544
Title: poor error message
Keywords: 
Submitter: John Reppy
Date: 4/16/92
Version: 0.81
Severity: minor
Problem: 
  The error message

    Error: non-constructor applied to argument in pattern

  would be much more useful if it gave the name of the  identifier.
Comment: [dbm, 10/7/92]
  There are two places where this message was generated.  In elabutil.sml
  code has been added to print the bogus rator.  In astutil.sml the message
  has been changed to "nonidentifier applied to argument in pattern",
  but bogus pattern is not printed because there is no ast printer yet.
Status: fixed in 0.93 (?)
----------------------------------------------------------------------
Number: 545
Title: signature matching looping?
Keywords: 
Submitter: 	Amy Moormann Zaremski <amy+@cs.cmu.edu>
Date:		3/5/92
Version:	.75 (both with and without sourcegroup)
System:		Dec 3100, Mach ??(whatever default is right now) 
Severity:	minor
Problem:	Certain signature/structure combinations cause
		SML to "loop" (grow the heap until memory is
		exhausted).
Code:
		signature S = sig
		  val f : 'b -> int
		end

		structure S1:S = struct
		  fun f x = x
		end

Transcript:
Standard ML of New Jersey, Version 75, November 11, 1991
Arrays have changed; see Release Notes
val it = () : unit
- signature S = sig
=   val f : 'b -> int
= end;
signature S = 
  sig
    val f : 'a -> int
  end
- structure S1:S = struct
=   fun f x = x
= end;

[Major collection...
[Increasing heap to 2478k]

[Increasing heap to 4798k]
 92% used (1550460/1673392), 1188 msec]

[Increasing heap to 7002k]

[Major collection... 74% used (2960732/3949436), 2797 msec]

[Increasing heap to 11582k]

[Major collection...
[Increasing heap to 17730k]
 80% used (5808988/7231036), 5062 msec]

[Increasing heap to 21198k]

[Major collection...
[Increasing heap to 32438k]
 80% used (10635356/13238652), 9407 msec]

[Increasing heap to 32634k]

[Major collection... 73% used (13238652/17984796), 12468 msec]

[Increasing heap to 32710k]

[Major collection...
[Increasing heap to 32734k]

[Increasing heap to 32746k]

[Increasing heap to 32750k]

[Increasing heap to 32754k]

Warning: can't increase heap

Ran out of memory
Process Inferior smlsg exited abnormally with code 3
Status: fixed in 0.83
----------------------------------------------------------------------
Number: 546
Title: System.architecture not initialized
Keywords: 
Submitter: Gene Rollins, Dave MacQueen
Date: 4/24/92
Version: 0.81
Severity: minor
Problem: 
  System.architecture not initialized because comment brackets
  in cps/shareglue.sml haven't been removed.
Status: fixed in 0.81
----------------------------------------------------------------------
Number: 547
Title: interrupt not working (inside emacs)
Keywords: 
Submitter:      slind@research.att.com
Date:           4/27/92
Version:        81
System:         mips (It doesn't occur on the sun4)
Severity:       major
Problem:     1) In gnu emacs, sml goes into an infinite loop when I hit the 
                interrupt key, i.e., on the DEL character. Then sml seems to
                ignore signals: the only way to regain control is to kill the
                sml process. Merely exiting emacs will not kill the sml 
                process.

             2) A related problem is that interrupt doesn't give the right
                exception (and not until a carriage return): it returns the
                Abort exception.
                
Transcript:     

1) (Inside gmacs.)

    $ sml
    Standard ML of New Jersey, Version 0.81, 9 April 1992
    Arrays have changed; see Release Notes
    val it = () : unit
    -
    \003
    \003
    \004


2) (In the shell)

    $ sml
    Standard ML of New Jersey, Version 0.81, 9 April 1992
    Arrays have changed; see Release Notes
    val it = () : unit
    - <DEL key struck: nothing happens; now issue a CR>
    std_in:3.1 Error: illegal token

    uncaught exception Abort
    -
Status: fixed in 0.82 (same as 550)
----------------------------------------------------------------------
Number: 548
Title: blast_read on ints
Keywords: 
Submitter:      slind@research.att.com
Date:           4/28/92
Version:        75, 81
System:         mips and sparc at least; probably all
Severity:       minor
Problem:        System.Unsafe.blast_X (where X probably = "read", but I'm not
                sure). Solitary ints aren't handled properly: in 81, core gets
                dumped; in 75, the wrong value is returned.
Transcript:     

In 81:
       $ sml
       Standard ML of New Jersey, Version 0.81, 9 April 1992
       Arrays have changed; see Release Notes
       val it = () : unit
       - val outs = open_out "foo";
       val outs = - : outstream
       - System.Unsafe.blast_write(outs,1);

       [Major collection...abandoned]
       val it = () : unit
       - close_out outs;
       val it = () : unit
       - val ins = open_in "foo";
       val ins = - : instream
       - System.Unsafe.blast_read ins : int;
       Memory fault - core dumped
       $ 


In 75:

       -  val outs = open_out "foo";
       val outs = - :outstream
       - System.Unsafe.blast_write(outs,1);
       [Major collection...abandoned]
       val it = () :unit
       - close_out outs;
       val it = () :unit
       - val ins = open_in "foo";
       val ins = - :instream
       - System.Unsafe.blast_read ins : int;
       val it = 3242475 :int
       -
Status: fixed in 0.86
----------------------------------------------------------------------
Number: 549
Title: Match exception while compiling
Keywords: 
Submitter:      jont@uk.co.harlqn
Date:		28/04/92
Version:        SML of NJ version 0.75
System:         Sun 4/330 with SunOS 4.1.1
Severity:       minor
Transcript:
- val _ = =;
std_in:1.9 Error: nonfix identifier required

uncaught exception Match

Comment: I guess this shouldn't happen. It's not the sort of
thing I type regularly, I was prompted to do it by the compiler's
habit of inserting = all over the place when it thinks I've left out
an identifier.
Comment: in 0.89 produces following
- val _ = = ;
std_in:0.0 Error: nonfix identifier required
Error: Compiler bug: elabVB
-
Status: fixed in 0.91 (dbm)
----------------------------------------------------------------------
Number: 550
Title: interrupt on MIPS
Keywords: 
Submitter: Lal George
Date: 4/29/92
Version: 0.81
System: MIPS/Riscos 4.52
Severity: major
Problem: 
0.81 on the MIPS has problems with signal handling. 
An interrupt (ctrl-c) causes it to go into deep space, 
eating up cpu time.
Status: fixed in 0.82
----------------------------------------------------------------------
Number: 551
Title: large integers yield Illegal instruction
Keywords: 
Submitter: Kjeld H. Mortensen | Email: kjeld@metasoft.com
Date: 4/29/92
Version: 0.81
System: ?
Severity: major
Problem: 
  Large integer literal causes illegal instruction.
Transcript: 
  metasparc 141 : /d1/tools/njsml/81/sml.sparc.ns
  Standard ML of New Jersey, Version 0.81, 9 April 1992
  Arrays have changed; see Release Notes
  val it = () : unit
  - 536870911;
  val it = 536870911 : int
  - 536870912;
  Illegal instruction
  metasparc 142 :
Comments:
  536870912 seems to be 2^29. (Similar behaviour, of course, for 
  corresponding negative numbers.)

  This compiler was build with 'makeml -noshare' on a Sun4, but
  compilers build with 'makeml' have same behaviour.

  In SML/NJ v0.80 this is no problem. Here integers can be 
  up to (2^30)-1 and it doesn't give 'Illegal instruction'.
Status: fixed in 0.81 (?)
----------------------------------------------------------------------
Number: 552
Title: Error message line numbers from std_in (see also 575)
Keywords: 
Submitter:      Lal George
Date:		4/30/92
Version:        0.81
System:         all
Severity:       major
Problem:        Error line numbers are incorrect in the interactive session.
Transcript:     

	Standard ML of New Jersey, Version 0.81, 9 April 1992
	Arrays have changed; see Release Notes
	val it = () : unit
	- val x = 1;
	val x = 1 : int
	- fun f x = val y = 2 in x + y end;
-->	std_in:4.11 Error: syntax error found at VAL
	- val x = 3;
	val x = 3 : int
	- val x = 4;
	val x = 4 : int
	-  fun f x = val y = 2 in x + y end;
-->	std_in:6.12 Error: syntax error found at VAL

Comments:
	This is a nuisance for programs that do regression testing,
or under emacs ML-mode.
Status: fixed in 0.91
----------------------------------------------------------------------
Number: 553
Title: incorrect syntax accepted
Keywords: 
Submitter: John Reppy
Date: 4/30/92
Version: 0.81a
Severity: minor
Problem: 
  The following things are not legal SML syntax, but we accept them:
Transcript: 
  Standard ML of New Jersey, Version 0.81, 9 April 1992
  Arrays have changed; see Release Notes
  val it = () : unit
  - let in 1 end;
  val it = 1 : int
  - let ; in 1 end;
  val it = 1 : int
  - let ;;; in 1 end;
  val it = 1 : int
  - 
Fix:
  change "LET ldecs IN " to "LET ldec ldecs IN"
Note that there are probably two places where this occurs; the other
is "LET sdecs IN" or something like that.
  Note: the Definition allows an "empty declaration" so this isn't a bug.
Status: not a bug
----------------------------------------------------------------------
Number: 554
Title: unused token constructor QUERY
Keywords: 
Submitter: John Reppy
Date: 4/29/92
Version: 0.81a
Severity: trivial
Problem: 
  I notice that there is a terminal symbol named QUERY declared in
  ml.grm, which is never used.
Fix: remove QUERY constructor
Status: fixed in 0.90
----------------------------------------------------------------------
Number: 555
Title: window signal
Keywords: 
Submitter:      John Reppy (jhr@research.att.com)
Date:           5/8/92
Version:        versions 75-81 (at least)
System:         RISCOS (R3000 & R6000)
Severity:       major
Problem:        resizing a shell window (xterm or cmdtool) that is running sml
		causes the sml process to either die or go into an infinite loop.
Comments:
  This is likely a problem with the handling of WINCH signals, but it doesn't seem
  to be related to the general problems with signals on the MIPS in 0.81.
Status: fixed in 0.82
----------------------------------------------------------------------
Number: 556
Title: large integers on Sparc
Keywords: 
Submitter:      <Sven Doerr, Univ. Karlsruhe, Germany; sd@ira.uka.de>
Date:		5/12/92
Version:        <SML of NJ version number, 0.81>
System:         <sun4, SunOS Release 4.1.1>
Severity:       <minor>
Problem:        <typing large integers at top level or arithmetic overflow
		 aborts sml with: Illegal instruction>
Code:           < 0x80000000 <return> >
Transcript:     <
		Standard ML of New Jersey, Version 0.81, 9 April 1992
		Arrays have changed; see Release Notes
		val it = () : unit
		- 100000 * 100000;
		Illegal instruction
		>
Status: fixed in 0.83
----------------------------------------------------------------------
Number: 557
Title: sparc signals
Keywords: 
Submitter:      Andre Kramer akramer@ecrc.de
Date:           5/14/92
Version:        0.75 
System:         sparc
Severity:       <minor, major, or critical>
Problem:        asynchronous exceptions for sparc

       file SPARC.prim.s

                _savefpregs  
		          retl
        		  nop
       does nothing.

       in signal.c 

                 /*
     		  * save floating point registers.
                  */
                  savefpregs(msp);
                  fpregs = ((int *)(msp->ml_allocptr)) + 1;
                  msp->ml_allocptr += (NSAVED_FPREGS*2 + 1) * sizeof(int);

       allocates 1 word from heap and later saves a pointer to it (fpregs). 
       this word should contain a descriptor (len 0,tag string): 
Fix:
       (MAKE_DESC(NSAVED_FPREGS*8,tag_string)) 
       as is done in _savefpregs for the M68, MIPS.  
       (VAX is same as Sparc).

Comments:
        I have a another question on the new calling conventions 
        (CALLEESAVE) for sparc.
        If register masks in code strings don't contain the 
        CLOSURE_INDX the last bit is 0. 
        A mask then either looks like a pointer or an int.
        Does this not affect the garbage collector?  
Status: fixed in 0.81 --- some version between 0.75 and 0.81
----------------------------------------------------------------------
Number: 558
Title: local...end structure expressions not working in 0.80
Keywords: 
Submitter:      Tim Freeman, tsf@cs.cmu.edu
Date:		5/15/92
Version:        0.80
System:         Sun 4 running Mach
Severity:       minor
Problem:        The new compiler doesn't know that local...end is
			sensible at the structure level.
Transcript:     val it = () : unit
		- System.Compile.makeSource ("foo",1,std_in,true,std_out);
		val it = prim? : source
		- val staticEmpty = System.Env.staticPart (System.Env.emptyEnv ());
		val staticEmpty = prim? : staticEnv
		- val s = System.Compile.makeSource ("foo",1,std_in,true,std_out);
		val s = prim? : source
		- System.Compile.compile (s,staticEmpty);
		- local
		=    structure x = struct val z = 3 end
		= in
		=    structure y = struct val w = x.z end
                = end;
		uncaught exception Compile
Status: fixed in 0.84
----------------------------------------------------------------------
Number: 559
Title: static environment not cleaned up
Keywords: 
Submitter: Dave MacQueen
Date: 5/17/92
Version: 0.81
Severity: average
Problem: 
  Top level static environment is not consolidated in the interactive
  loop, so hidden static bindings are not removed and static environment
  grows too fast.
Fix:
  Add a call of Environment.consolidate when newenv is built at the
  end of function evalLoop in functor Interact (build/interact.sml).
Status: fixed in 0.84
----------------------------------------------------------------------
Number: 560
Title: blast functions and separate compilation
Keywords: 
Submitter:      Emden R. Gansner, erg@ulysses.att.com
Date:           5/18/92
Version:        0.81c
System:         Sparc 2, SunOS 4.1
Severity:       major
Problem:        Separate compilation facility is broken
Code:           
  structure SepComp =
    struct
  
    val fname = "a.o"
  
    fun compFile () = let
      open System.Compile System.Env
      val targetWrite : (outstream * compUnit) -> unit = System.Unsafe.blast_write
      val staticPerv = staticPart(!pervasiveEnvRef)
      val sourceF = open_string "structure A = struct end"
      val source = makeSource("", 1, sourceF, false, std_out)
      val compUnit as (static, code) =
              (compile(source,staticPerv)) 
                 handle e => (closeSource source; raise e)
      val outstr = open_out fname
      in
        targetWrite (outstr, compUnit);
        closeSource source;
        close_out outstr
      end
  
    fun loadFile () = let
      open System.Compile
      val targetRead : instream -> compUnit = System.Unsafe.blast_read
      val instr = open_in fname
      val effectiveEnv = !System.Env.pervasiveEnvRef
      val _ = print "starting load \n"
      val (staticUnit,codeUnit) = targetRead instr
      in
        print "readUnit done \n";
        close_in instr;
        print "starting execute \n";
        execute((changeLvars staticUnit,codeUnit), effectiveEnv);
        print "finished execute \n"
      end
    end
  
  val _ = SepComp.compFile ()
  val _ = SepComp.loadFile ()
  
Transcript:     loadFile hangs during execute; sending an interrupt
                signal produces a core dump

Comments:       This program works fine in 0.80. Changes made to
                blast_read and blast_write in 0.81 are probably the
                root of the problem. The above program also failed
                in 0.81b, but hung during blast_read. This was mentioned
                to Lal, who, I believe, produced 0.81c as a partial fix.
Status: fixed in 0.82
----------------------------------------------------------------------
Number: 561
Title: exportFn images too big (same as 489)
Keywords: 
Submitter: Andrew Koenig
Date: 5/19/92
Version: 0.75
System: Sparc
Severity: minor
Problem: 
  For practical reasons, it would be nice to get
  exportFn to create less bulky executables for small programs.
  For example, here is a somewhat simplified version of the
  `echo' command:

	  fun echo [] = print "\n"
	    | echo (h::nil) = print (h^"\n")
	    | echo (h::t) = (print(h ^ " "); echo t)

	  fun main(argv, envp) = echo(tl argv)

  When I use `exportFn' to make an executable of this, it takes
  136 kbytes using 0.53 on a 10th Edition machine.  Using 0.75
  on a Sparcstation, the executable is 471 kbytes.  Even if we
  allow that Sparc executables are bigger, it is hard to believe
  that that much baggage is truly necessary.
[from ark, 12/1/92:]
  I just built 0.92 and gave it a try.
  When built with -noshare, the following

	  fun main _ = print "Hello world\n";
	  exportFn ("xxx", main);

  yields a 946K executable with 860K of loadable data.
  This is as opposed to 376K/249K with 0.75,
  which in turn was about twice as big as 0.43.
[from Lal, 12/16/92]
  We mercifully had the result of exportFn for the lego theorem
  prover using version 0.66. So I built a noshare version of sml
  for the Sparc and rebuilt lego using version 0.92.

  There is more than a Mbyte increase in the size of the exported 
  image. Below, Olego is the image under 0.66, and lego is the version
  under 0.92.

  Either this is to be expected - which is bad, or there are references
  that are not being cleared - which is also bad.

  ----------------------------------------------------------------
  lutece:$ ls -l
  total 3104
  -rwxrwxrwx  1 dbm        999456 Mar 26  1991 Olego*
  -rwxr-xr-x  1 george    2146336 Dec 16 18:38 lego*
Status: fixed in 0.93c
----------------------------------------------------------------------
Number: 562
Title: SML hanging under telnet (under Mach) (also #540)
Keywords: 
Submitter:      tsf@cs.cmu.edu
Date:		5/19/92
Version:        0.80
System:         Pmax, running Mach.  Also Sun 4's running mach, but
		more rarely.  (I'm referring to the type of the
		machine running SML, not the type of the machine
		running telnet.) 
Severity:       minor
Problem:        When running under telnet, sml intermittently hangs on output.
Code:           Anything that produces lots of output will do.
Transcript:     It's long, so I put it at the end of this message.
		It's not very informative. 
Comments:	If I say "sml | cat -u" instead of "sml", things work
		fine.  If I create a remote xterm and run sml within
		that, or a remote gnu-emacs and run sml within that,
		things work fine.  The problem only happens when sml's
		standard output is a pty controlled by telnet.

		The type of the machine running sml seems to make
		more of a difference than the type of the machine at
		the other end of the telnet connection.
Fix:		Say "sml | cat -u" instead of "sml" to invoke sml at
		the other end of a telnet connection.

Looking at the code for flushbuf in boot/perv.sml, I see that you wait
for output to become possible before sending the first bytes of
output, but inside the loop in write_all in runtime/cfuns.c, you don't
wait for output to become possible after a partial write.  This
discrepancy is strange, but I don't see how it could give rise to this
bug.  Do you use nonblocking IO?  Why do you wait for output to become
possible before starting a write?

I wouldn't be surprised if telnet is the only device you output to
that doesn't always write all of the bytes you ask it to.

Here's the transcript.  The details don't matter much, anything that
produces this much chatter is very likely to hang.  This works fine
when run locally or when piped through "cat -u".

% telnet desert.fox
Trying 128.2.206.48...
Connected to DESERT.FOX.CS.CMU.EDU.
Escape character is '^]'.
DESERT.FOX.CS.CMU.EDU TCP Telnet service.

4.3 BSD UNIX (DESERT.FOX.CS.CMU.EDU) (ttyP0)

login: tsf
Password:
Last login: Thu May 14 13:11:17 from 128.2.222.175 (*Unknown*)
This login: Tue May 19 14:28:07 from 128.2.222.175 (*Unknown*)
% sml-sg
Standard ML of New Jersey, Version 0.80, April 2, 1992
  with SourceGroup 2.1b built on Fri May  8 10:02:15 EDT 1992
val it = () : unit
- use "load.sml";

[closing /afs/cs/user/tsf/sml/lib/setparams.sml]
Eof
val it = () : unit
/afs/cs/user/tsf/sml/lib/link.sml
/afs/cs/user/tsf/sml/lib/subst.sig.sml
/afs/cs/user/tsf/sml/lib/subst.sml
/afs/cs/user/tsf/sml/lib/util.sig.sml
/afs/cs/user/tsf/sml/lib/util.sml
val libg = 1 : ?.group
val makeload = fn : unit -> unit
[closing /afs/cs/user/tsf/sml/lib/lib.sml]
Eof
val it = () : unit
refine.lex.sml
refine.grm.sig
refine.grm.sml
unify.sml
unify.sig.sml
term.sml
term.sig.sml
subtypedata.sml
subtypedata.sig.sml
subtype.sml
subtype.sig.sml
parse.sml
parse.sig.sml
mltype.sml
mltype.sig.sml
link.sml
interface.sml
interface.sig.sml
interactive.sml
base.sml
absyn.sml
absyn.sig.sml
refine.lex
refine.grm
val newg = 3 : ?.group
val loadref = fn : unit -> unit
[reading /afs/cs/user/tsf/sml/lib/.@sys/util.sig.sml.bin]
signature UTIL
[reading /afs/cs/user/tsf/sml/lib/.@sys/util.sml.bin]
functor Util
[reading /afs/cs/user/tsf/sml/lib/.@sys/subst.sig.sml.bin]
signature SUBST
[reading /afs/cs/user/tsf/sml/lib/.@sys/subst.sml.bin]
functor Subst
[reading /afs/cs.cmu.edu/project/ergo-tsf/sml/thesis/.@sys/term.sig.sml.bin]
signature TERM
[reading /afs/cs.cmu.edu/project/ergo-tsf/sml/thesis/.@sys/unify.sig.sml.bin]
signature UNIFY
[reading /afs/cs.cmu.edu/project/ergo-tsf/sml/thesis/.@sys/unify.sml.bin]
functor Unify
[reading /afs/cs.cmu.edu/project/ergo-tsf/sml/thesis/.@sys/term.sml.bin]
functor Term
[reading /afs/cs.cmu.edu/project/ergo-tsf/sml/thesis/.@sys/subtypedata.sig.sml.bin]
signature SUBTYPEDATA
[reading /afs/cs.cmu.edu/project/ergo-tsf/sml/thesis/.@sys/subtypedata.sml.bin]
functor SubtypeData
[reading /afs/cs.cmu.edu/project/ergo-tsf/sml/thesis/.@sys/mltype.sig.sml.bin]
signature MLTYPE
[reading /afs/cs.cmu.edu/project/ergo-tsf/sml/thesis/.@sys/subtype.sig.sml.bin]
signature SUBTYPE
[reading /afs/cs.cmu.edu/project/ergo-tsf/sml/thesis/.@sys/subtype.sml.bin]
functor Subtype
[reading /afs/cs.cmu.edu/project/ergo-tsf/sml/thesis/.@sys/base.sml.bin]
signature LR_PARSER
functor Join
signature ARG_PARSER
signature STREAM
signature FIFO
functor JoinWithArg
signature TOKEN
<other binding>
<other binding>
signature PARSER_DATA
signature LR_TABLE
<other binding>
signature PARSER
signature LEXER
signature ARG_LEXER
[reading /afs/cs.cmu.edu/project/ergo-tsf/sml/thesis/.@sys/refine.grm.sig.bin]
signature Refine_LRVALS
signature Refine_TOKENS
[reading /afs/cs.cmu.edu/project/ergo-tsf/sml/thesis/.@sys/interface.sig.sml.bin]

(and it hanged here!  Pressing ^C unhangs it and returns me to the top level.)

Status: fixed in 0.84
----------------------------------------------------------------------
Number: 563
Title: trig functions return garbage on large args
Keywords: 
Submitter:      Andrzej Filinski, andrzej@cs.cmu.edu
Date:		5/29/92
Version:        0.75 (also in 0.80)
System:         all
Severity:       minor
Problem:        trig. functions return huge, random results for arguments 
		greater than approx. 6.747E9 (= 2 pi * maxint).
Transcript:     Standard ML of New Jersey, Version 75, November 11, 1991
		Arrays have changed; see Release Notes
		val it = () : unit
		- sin 6.746E9;
		val it = 0.577192771297902 : real
	        (* correct to about 6 significant digits, as expectable *)
		- sin 6.747E9;
		val it = ~1.17525075405876E64 : real
Comments:	The problem seems to be with the overflow handling in 
		rtoi/drem, file boot/math.sml.
Status: fixed in 0.84
----------------------------------------------------------------------
Number: 564
Title: problems on HP9000s400
Keywords: 
Submitter:      Kjeld H. Mortensen (kjeld@metasoft.com)
Date:           6/2/92
Version:        0.81
System:         HP9000s400, HPUX 8.0, 32Mb ram, >70Mb swap
Severity:       minor (but might be major for other people)
Problem:        Bug in sun2hp.el
Code:           Do a 'makeml -m68 hpux8'
Transcript:     

neptune 125 : makeml -m68 hpux8
makeml> (cd runtime; make clean)
        rm -f *.o lint.out prim.s linkdata allmo.s run
makeml> rm -f mo
makeml> ln -s ../mo.m68 mo
makeml> (cd runtime; rm -f run allmo.o allmo.s)
makeml> (cd runtime; make MACHINE=M68  'CFL=-Wl,-a,archive' 'LIBS=' 'DEFS= -DHPUX -DRUNTIME=\"runtime\"' linkdata)
        cc -g -Wl,-a,archive -DM68 -DHPUX -DRUNTIME=\"runtime\" -o linkdata linkdata.c
(cd runtime; grep -v mo/Math.mo IntM68.mos > Tmp.mos)
makeml> runtime/linkdata [runtime/Tmp.mos]
runtime/linkdata> as runtime/allmo.s -o runtime/allmo.o
makeml> (cd runtime; ...)
makeml>   /lib/cpp -DCALLEESAVE=0 -DM68 -DHPUX -DASM M68.prim.s > prim.s
makeml>   emacs -batch -l sun2hp.el prim.s prim.s
label <2> has moved

makeml>   as -o prim.o prim.s
as error: "prim.s" line 255: invalid instruction mnemonic (.text)
as error: "prim.s" line 255: syntax error
[...rest of error msgs deleted...]

Comments:

"label <2> has moved" is printed by the LISP fn replace-all-label-definitions.
It gets confused because there are more than one label on a line (this
kind of lines with multible labels are produced by the (new) macro 
"CHECKLIMIT" in M68.prim.s).

Fix:

Replace replace-all-label-definitions with the following fn: (the fix does
the following: instead of moving to the beginning of the line in order
to search for the label, the pointer is only moved 2 chars to the left
of the label.)

;; replace-all-label-definitions -- change each of the old label 
;; definitions to their new value.
;;
(defun replace-all-label-definitions (labels)
  (while labels
    (let* ((cur (car labels))
	   (old-label (label-old-label cur))
	   (point (label-point cur))
	   (new-label (label-new-label cur)))
      (goto-char (- point 2))
      (re-search-forward "\\([0-9]+\\):" (point-max) t)
      (if (not (string-equal (buffer-substring (match-beginning 1)
					       (match-end 1))
			     old-label))
	  (error "label <%s> has moved" old-label)
	(replace-match (concat new-label ":"))))
      (setq labels (cdr labels))))
[Reppy:]
Probably the easiest fix for this is to change the CHECKLIMIT macro to

#define CHECKLIMIT                                      \
            1: 						\
               jgt      2f;                             \
               lea      1b,a5;                          \
               rts;                                     \
            2:

[Mortensen:]
I don't think this will work since /lib/cpp on the HP9000s400 (at least
on ours) converts CHECKLIMIT into

  1: jgt 2f; lea 1b,a5; rts; 2:

If sun2hp.el is fixed, anybody can make changes to M68.prim.s without
having to remember that multible labels on a line are not allowed, just
because the translator algorithm in sun2hp.el cannot handle it.

Status: fixed in 0.87
----------------------------------------------------------------------
Number: 565
Title: System.Directory.listDir on SGI
Keywords: 
Submitter:      John Reppy (jhr@research.att.com)
Date:           6/4/92
Version:        0.81
System:         SGI 3D/480, SGI Crimson (Irix 4.0.1, 4.0.4)
Severity:       major
Problem:
  Using the function System.Directory.listDir causes
  sml to go into an uninterruptable infinite loop.
Transcript:     <transcript of session illustrating problem>
  Standard ML of New Jersey, Version 0.81, 15 May 1992
  val it = () : unit
  - System.Directory.listDir ".";
Comments:
  This code often seems to be flakey.  Maybe we should
  switch to using the underlying OS code.
Status: fixed in 0.93
----------------------------------------------------------------------
Number: 566
Title: An addition to sun2hp.el (?)
Keywords: 
Submitter:      Kjeld H. Mortensen (kjeld@metasoft.com)
Date:           6/2/92
Version:        0.81
System:         HP9000s400, HPUX 8.0, 32Mb ram, >70Mb swap
Severity:       minor (but might be major for other people)
Problem:        Tranlation entry missing in sun2hp.el
Code:           Do a 'makeml -m68 hpux8' with the fix to sun2hp.el I send 
                earlier
Transcript:     

neptune 126 : makeml -m68 hpux8
makeml> (cd runtime; make clean)
        rm -f *.o lint.out prim.s linkdata allmo.s run
makeml> rm -f mo
makeml> ln -s ../mo.m68 mo
makeml> (cd runtime; rm -f run allmo.o allmo.s)
makeml> (cd runtime; make MACHINE=M68  'CFL=-Wl,-a,archive' 'LIBS=' 'DEFS= -DHPUX -DRUNTIME=\"runtime\"' linkdata)
        cc -g -Wl,-a,archive -DM68 -DHPUX -DRUNTIME=\"runtime\" -o linkdata linkdata.c
(cd runtime; grep -v mo/Math.mo IntM68.mos > Tmp.mos)
makeml> runtime/linkdata [runtime/Tmp.mos]
runtime/linkdata> as runtime/allmo.s -o runtime/allmo.o
makeml> (cd runtime; ...)
makeml>   /lib/cpp -DCALLEESAVE=0 -DM68 -DHPUX -DASM M68.prim.s > prim.s
makeml>   emacs -batch -l sun2hp.el prim.s prim.s
Wrote /d1/release/tools/njsml/workatt81/src/runtime/prim.s
makeml>   as -o prim.o prim.s
as error: "prim.s" line 420: invalid instruction mnemonic (jpl)
as error: "prim.s" line 420: syntax error
as error: "prim.s" line 458: invalid instruction mnemonic (jpl)
as error: "prim.s" line 458: syntax error
as error: "prim.s" line 479: invalid instruction mnemonic (jpl)
as error: "prim.s" line 479: syntax error
as error: "prim.s" line 500: invalid instruction mnemonic (jpl)
as error: "prim.s" line 500: syntax error
as error: "prim.s" line 527: invalid instruction mnemonic (jpl)
as error: "prim.s" line 527: syntax error

Comments (+Fix?):

The intruction "jpl" is not know to the sun2hp translator (in fn do-subst).
I don't know what jpl is supposed to do, but my _guess_ is that it should
be translated into the branch instruction "bpl.w" (anologious to transl.
of jeq, jge, ... etc.).

Shouldn't the line

  (replace-re "\\<jpl" "bpl.w")

be added to the fn do-subst in sun2hp.el?
Status: fixed in 0.90
----------------------------------------------------------------------
Number: 567
Title: makeml does not succeed on HPUX (680x0 problem)
Keywords: 
Submitter:      Kjeld H. Mortensen (kjeld@metasoft.com)
Date:           6/2/92
Version:        0.81
System:         HP9000s400, HPUX 8.0, 32Mb ram, >70Mb swap
Severity:       minor (but might be major for other people)
Problem:        A makeml does not succeed (exception raised in Loader)
Code:           Do a 'makeml -m68 hpux8' with the two fixes to sun2hp.el 
                I send earlier
Transcript:     

>From time to time, I get different results:
---
> makeml -m68 hpux8
[...stuff deleted...]
signature CLEANUP = ...
signature WEAK = ...
signature SUSP = ...
signature POLY_CONT = ...
signature UNSAFE = ...
signature SYSTEM = ...
[closing boot/system.sig]
signature MATH = ...
structure Math : MATH
[closing boot/math.sml]

[Major collection... 20% used (339576/1680172), 250 msec]
uncaught exception (Loader): mlyAction
---
> makeml -m68 hpux8
[...stuff deleted...]
signature LIST = ...
signature VECTOR = ...
signature ARRAY = ...
signature REAL_ARRAY = ...
signature BYTEARRAY = ...
signature IO = ...
signature BOOL = ...
signature STRING = ...
signature INTEGER = ...
signature BITS = ...
signature REAL = ...
signature GENERAL = ...
[closing boot/perv.sig]
uncaught exception (Loader): Ord
---
> makeml -m68 hpux8
[...stuff deleted...]
structure Core : ...
[closing boot/dummy.sml]
signature REF = ...
signature LIST = ...
signature VECTOR = ...
signature ARRAY = ...
signature REAL_ARRAY = ...
signature BYTEARRAY = ...
signature IO = ...
signature BOOL = ...
signature STRING = ...
signature INTEGER = ...
signature BITS = ...
signature REAL = ...
signature GENERAL = ...
[closing boot/perv.sig]
uncaught exception (Loader): Ord
---
> makeml -m68 hpux8
[...stuff deleted...]
signature CLEANUP = ...
signature WEAK = ...
signature SUSP = ...
signature POLY_CONT = ...
signature UNSAFE = ...
signature SYSTEM = ...
[closing boot/system.sig]
signature MATH = ...
structure Math : MATH
[closing boot/math.sml]

[Major collection... 20% used (340948/1682456), 333 msec]
uncaught exception (Loader): Ord
---

Comments:

I cannot tell if this phenomenon is caused by the two fixes I made to 
sun2hp.el:

;; do-subst -- substitute mnemonics, register names, comment symbols etc.
;;
(defun do-subst ()
[...]
  (replace-re "\\<jpl" "bpl.w")
[...]

and the other in:

;; replace-all-label-definitions -- change each of the old label 
;; definitions to their new value.
;;
(defun replace-all-label-definitions (labels)
  (while labels
    (let* ((cur (car labels))
	   (old-label (label-old-label cur))
	   (point (label-point cur))
	   (new-label (label-new-label cur)))
      (goto-char (- point 2))
      (re-search-forward "\\([0-9]+\\):" (point-max) t)
      (if (not (string-equal (buffer-substring (match-beginning 1)
					       (match-end 1))
			     old-label))
	  (error "label <%s> has moved" old-label)
	(replace-match (concat new-label ":"))))
      (setq labels (cdr labels))))
[Reppy:]
This bug also occurs on the Sun-3 and NeXT machines.
It seems to be a general problem with the M68.
Status: fixed in 0.84
----------------------------------------------------------------------
Number: 568
Title: crash on sparc on large compilations
Keywords: 
Submitter: Pierre Cregut
Date: 6/5/92
Version: 0.82
System: sparc, SunOS 4.2
Severity: serious
Problem: 
  On large compilations (e.g. compiling the compiler) on sparcs that
  are shared with other large jobs (e.g. lisp or another sml), the
  compiler will die with a bus error or illegal instruction or something
  equally drastic.  This is fairly consistent.
Comments:
  Can this be avoided by forcing sml to grap a large memory chunk for
  the heap and hold onto it.
Status: obsolete
----------------------------------------------------------------------
Number: 569
Title: failed type inference with flexible records
Keywords: 
Submitter:      jont@uk.co.harlqn
Date:		6/5/92
Version:        SML of NJ version number 0.75
System:         Sun 4/330 SunOS 4.1.1
Severity:       major
Problem:        Failed type inference with flexible records
Code:
fun f x = let val y = #1 x val z = #2 x in (y, z, x:('a * 'b)) end;
Transcript:
- fun f x = let val y = #1 x val z = #2 x in (y, z, x:('a * 'b)) end;
fun f x = let val y = #1 x val z = #2 x in (y, z, x:('a * 'b)) end;
val f = fn : 'a * 'b -> 'a * 'c * ('a * 'b)
- f(1,0);
val it = (1,-,(1,0)) : int * 'a * (int * int)
- 
Comments:	The type should be 'a * 'b * ('a * 'b)
Fix:		Better unification I suspect!
Status: fixed in 0.85
----------------------------------------------------------------------
Number: 570
Title: flexrecord equality types
Keywords: 
Submitter:      Mark Lillibridge (mdl@cs.cmu.edu)
Date:		6/8/92
Version:        0.82
System:         RISC O/S, MIPS (?)
Severity:       minor
Problem:        Flexrecords are always assumed to contain non-equality
		types when this need not be so.  This leads to legal
		programs being rejected.
Code:           Consider the following code:

	fun force_record {x=x, y=y} = 3;

	fun force_eq x = (x = x);

		Then, the following function types ok since we close the
flexrecord before requiring equality:

	fun bar (r as {x=x, ...}) = (force_record r; force_eq r);

		But the following function fails with a "equality type
required" error because we attempt to require that the open flexrecord
be an equality type:

	fun foo (r as {x=x, ...}) = (force_eq r; force_record r);

Transcript:     

- use "bug.sml";	(* same code as above *)
val force_record = fn : {x:'a,y:'b} -> int
val force_eq = fn : ''a -> bool
val bar = fn : {x:''a,y:''b} -> bool
bug.sml:7.29-7.56 Error: operator and operand don't agree (equality type required)
  operator domain: ''Z
  operand:         {x:'Y,...}
  in expression:
    force_eq r
[closing bug.sml]

Comments:	This problem is due to incorrect code in the type-handling
part of the SML/NJ compiler.  Fixing this will require changing the
definition of types so that flexrecords carry a boolean telling if they
are required to have only equality types or not.  Unify then needs to be
updated to use this information in the proper way.

Status: fixed in 0.85
----------------------------------------------------------------------
Number: 571
Title: no occurs check when instantiating flexrecords
Keywords: 
Submitter:      Mark Lillibridge (mdl@cs.cmu.edu)
Date:		6/8/92
Version:        0.82
System:         RISC O/S, MIPS (?)
Severity:       minor
Problem:        When flexrecords are instantiated (additional fields
		added/closed), no occurs check is done.  The failure to
		do this can result in cyclic types and hanging the type
		checker.
Code:           The following code hangs the typechecker:

	fun foo {x=x, y=y, z=(z as {...})} = foo z;

Transcript:     
	- fun foo {x=x, y=y, z=(z as {...})} = foo z;
	[hangs here, using more and more space forever]

Comments:	The problem is in the unify routine.  It needs to do
		an occurs check whenever it instantiates a flex record.
Status: fixed in 0.85
----------------------------------------------------------------------
Number: 572
Title: unify doesn't update depth for flex record types
Keywords: 
Submitter:      Mark Lillibridge (mdl@cs.cmu.edu)
Date:		6/8/92
Version:        0.82
System:         RISC O/S, MIPS (?)
Severity:       major			(* can result in unsoundness *)
Problem:        The unify routine in the SML/NJ compiler fails to update
		the depth fields of variables when dealing with flex
		records.  This causes the type checker to generalize
		types that should not be generalized.
Code:           Many examples are possible.  The simplest I can
		think of is:

		fun snd {a,b} = b;

		fun f (x as {a,...}) =
			let val u = snd x
			in
			    u
			end;

		Here, snd has type {a:'a,b:'b} -> 'b and acts to extract
		the b field of an a-b record.

		So, we start out defining function f.  The (x as
		{a,...}) in the argument list causes x to be bound to
		the type {a: 'a#1, ...}.  [#i means the variable has
		depth i.  I am assuming for this discussion that depths
		start with 1 and go up 1 for each lambda level.]

		Now, in the let val u = snd x, we have to unify the type
		of x with the argument type of snd, namely {a:'c,b:'b}.
		This results in x being bound to type {a:'a#1, b:'b#2}.
		Note the error here.  Type 'b should have depth 1 not 2
		since it is bound at the 1st lambda level (by variable
		x).  However, due to incorrect code in the unifier, this
		doesn't happen and 'b has type 2.

		Thus, when we finish typing the function body we get the
		type 'b#2, which the depth indicates can be safely
		generalized.  Thus, the function body has polymorphic
		type 'c.  This results in f getting type {a:'a, b:'b} ->
		'c when it should have the type {a:'a, b:'b} -> 'b.

Transcript:     

	- fun snd {a,b} = b;
	val snd = fn : {a:'a,b:'b} -> 'b
	- fun f (x as {a,...}) = let val u = snd x in u end;
	val f = fn : {a:'a,b:'b} -> 'c
	- f {a=0, b=true};
	val it = - : 'a

Comments:	The problem is in the handling of types by the SML/NJ
		compiler.  Flexrecords need to have a depth associated
		with them just like normal variables.  This is so that
		you can unify {a:'a#1, ...#1} with {a:'c#3, b:'d#3} and
		get {a:'a#1, b:'d#1} not {a:'a#1, b:'d#3}.  (Note the
		depth associated with the dots in that example.  This is
		the critical information missing from the current type
		representation.)
		
Related-bugs:	Bug reports #521 from Mark Leone, #533 from Richard
		O'Neill, and #569 from jont@uk.co.harlqn are all just
		(less clear) instances of this bug.

Status: fixed in 0.85
----------------------------------------------------------------------
Number: 573
Title: unifier detects spurious cycles with type abbrevs
Keywords: 
Submitter:      Mark Lillibridge (mdl@cs.cmu.edu)
Date:		6/9/92
Version:        0.82
System:         RISC O/S, MIPS (?)
Severity:       minor
Problem:        The unifier's occurs check sometimes detects a spurious
		cycle when a type variable is unified with a type
		abbreviation that stands for that type variable.
Code:           
		type 'a ID = 'a;

		fun f (x:'a) = (x:'a ID);

		fun g x = g (f x);

Transcript:

	- type 'a ID = 'a;
	type 'a  ID = 'a
	- fun f (x:'a) = (x:'a ID);
	val f = fn : 'a -> 'a ID
	- fun g x = g (f x);
	std_in:4.1-4.17 Error: pattern and expression in val rec dec don't agree (circularity)
	  pattern:    'Z ID -> 'Y
	  expression: 'Z -> 'Y
	  in declaration:
	    g = (fn x => g (<exp>))

	[The above is an incorrect error because 'Z ID = 'Z and hence
the two types should unify without problems.]

Status: fixed in 0.85
----------------------------------------------------------------------
Number: 574
Title: redundant patterns in compiler
Keywords: 
Submitter: John Reppy
Date: 6/12/92
Version: 0.83
Severity: minor
Problem: 
The compiler reports the following redundant patterns in 0.83:

modules/sigmatch.sml:0.0 Warning: redundant patterns in match
        (DATACON {name=n1,rep=r1,...},DATACON {rep=r2,...}) => ...
  -->   _ => ...

absyn/printabsyn.sml:0.0 Warning: redundant patterns in match
        FCTB {def=FCTfct {def=def,param=STRvar <pat>,...},fctvar=FCTvar {access=access,name=fname,...}} => ...
        FCTB {def=VARfct {def=FCTvar <pat>,...},fctvar=FCTvar {access=access,name=fname,...}} => ...
  -->   _ => ...

Status: fixed in 0.85
----------------------------------------------------------------------
Number: 575
Title: line numbers in interactive error messages (same as 552)
Keywords: 
Submitter:      Tim Freeman <tsf@cs.cmu.edu>
Date:		6/14/92
Version:        0.80
System:         Sun 4, mach
Severity:       minor
Problem:        The line numbers printed for errors on std_in are erratic.
Transcript:     
	% /usr/misc/.sml/bin/sml
	- aoeiaoei;
	std_in:3.1-3.8 Error: unbound variable or constructor aoeiaoei
	- aoeiaoei;
	std_in:0.0-0.0 Error: unbound variable or constructor aoeiaoei
	- aoeiaoei
	= ueoaoeuaoeu;
	std_in:0.0-0.0 Error: unbound variable or constructor aoeiaoei
	std_in:4.1-4.11 Error: unbound variable or constructor ueoaoeuaoeu
	-	 
Comments: 
	In my opinion, the line numbers reported for
	the above errors should all have been 1, except the last one should
	have been 2. 

Status: same as 552
----------------------------------------------------------------------
Number: 576
Title: pattern matching in interpreter broken
Keywords: 
Submitter:      slind@research.att.com
Date:           6/14/92
Version:        83
System:         mips and sparc at least; probably all
Severity:       major
Problem:        If System.Control.interp is true, pattern matching is broken.
                Manifested with list patterns.
Transcript:     

    $ sml
    Standard ML of New Jersey, Version 0.83, June 12, 1992
    val it = () : unit
    - System.Control.interp := true;
    val it = () : unit
    - val [_] = [1];
    std_in:0.0 Warning: binding not exhaustive
            _ :: nil = ...

    uncaught exception Match
    - System.Control.interp := false;
    val it = () : unit
    - val [_] = [1];
    std_in:0.0 Warning: binding not exhaustive
            _ :: nil = ...
    - ^D
    $ 

Comments:

There is a bug in the interpreter since version 77 caused by a change in
the representation of data constructors.
- System.Control.interp:= true;
val it = () : unit
- val [x] = [1];
std_in:3.1-3.13 Warning: binding not exhaustive
        x :: nil = ...

uncaught exception Match
-
The reason is that cons is tagged with UNTAGGEDREC 2 and the case UNTAGGEDREC
is not treated by the switch.
Lal and I have infered that the only thing the switch interpretor had to
figure out is whether the constructor is tagged or not. So the only necessary
lines to add are:
-cregut->diff codegen/interp.sml /usr/local/sml/77/src/codegen/interp.sml

291,296d290
<            | f((DATAcon(_,UNTAGGEDREC _),ans)::rest) =
<               let val rest' = f rest
<                   val ans' = M ans
<                in fn x => if (U.boxed x) then ans' else rest' x
<               end
<

Is it true or do we need something else ?

Pierre

Status: fixed in 0.86
--------------------------------------------------------------------
Number: 577
Title: use of vectors crashes NeXT
Keywords: 
Submitter:      Richard O'Neill <richard@smaug.questor.wimsey.bc.ca>
Date:		6/18/92
Version:        0.75
System:         NeXTstation, OS2.1  and NeXTstation Turbo Color, OS 2.2.
Severity:       Major.
Problem:        

Extensive use of vectors (and probably arrays) when running on NeXTs
causes SML to crash with either "Bus Error", "Segmentation Fault",
"Illegal instruction" or "EMT trap". The same code, when run on SPARC
based Sun machines does not exhibit the same problem.

The code below creates a function called 'bug', which takes an integer
argument. The larger the argument, the more likely SML is to crash,
values like 10000 create an almost immediate crash, values such as 500
sometimes work and sometimes crash SML. (The code is for example purposes
only, I don't actually use code as inefficient as this normally! ;o)

Code (stored in file "bug.sml"):

    open Vector

    fun update(array,index,value) = 
	let
	    fun copy i = 

		if i = index then value
		else sub(array,i)
	    val size = length array
	in
	    if index < size then
		tabulate (size,copy)
	    else
		raise Vector.Subscript
	end

    fun reverse original =
	let
	    val size = length original
	    fun rev (current,count) =
		if count < size then
		    let
			val count'  = count + 1
			val current' =
			    update(current, count, sub(original, size-count'))
		    in
			rev (current', count')
		    end
		else current
	in
	    rev (original,0)
	end

    fun bug n = reverse (tabulate (n, fn x => x))

Transcript:

NeXT-Mach% sml
Standard ML of New Jersey, Version 75, November 11, 1991
Arrays have changed; see Release Notes
val it = () : unit
- use "bug.sml";
[opening bug.sml]
open Vector
val update = fn : 'a vector * int * 'a -> 'a vector
val reverse = fn : 'a vector -> 'a vector
val bug = fn : int -> int vector
[closing bug.sml]
val it = () : unit
- bug 500;
val it = - : int vector
- bug 500;
Bus error
NeXT-Mach% 

NeXT-Mach% sml
Standard ML of New Jersey, Version 75, November 11, 1991
Arrays have changed; see Release Notes
val it = () : unit
- use "bug.sml";
[opening bug.sml]
open Vector
val update = fn : 'a vector * int * 'a -> 'a vector
val reverse = fn : 'a vector -> 'a vector
val bug = fn : int -> int vector
[closing bug.sml]
val it = () : unit
- bug 5000;
EMT trap
NeXT-Mach%
NeXT-Mach% sml
Standard ML of New Jersey, Version 75, November 11, 1991
Arrays have changed; see Release Notes
val it = () : unit
- use "bug.sml";
[opening bug.sml]
open Vector
val update = fn : 'a vector * int * 'a -> 'a vector
val reverse = fn : 'a vector -> 'a vector
val bug = fn : int -> int vector
[closing bug.sml]
val it = () : unit
- bug 5000;
Bus error

Comments:

It gives an idea how 'wild' the crash is since the latter two cases in
the transcript should be identical, and aren't. I suspect it is some
kind of memory allocation bug, but who knows....

Comment: [dbm, 10/29/92]
  Couldn't reproduce this on a Sun 3 with 0.91.  Either the bug is
  cured or it is NeXT specific.
Status: fixed in 0.92
----------------------------------------------------------------------
Number: 578
Title: chatting (in runtime system) doesn't flush stdout
Keywords: 
Submitter:      Mark Leone (mleone@cs.cmu.edu)
Date:           6/24/92
Version:        80
System:         all
Severity:       minor
Problem:        chatting() doesn't flush stdout
Code:           
Transcript:     
Comments:	GC messages (and other diagnostic compiler output)
		sometimes appear before things that have already been 
		printed to stdout  (e.g. when redirecting batch compiler 
		output to a log file).  This can make it hard to debug 
		the compiler.
Fix:		Add "fflush(stdout)" to chatting() in runtime/run.c
Status: not a bug (inaccurate report according to awa)
----------------------------------------------------------------------
Number: 579
Title: Lexing an illegal token can lead to infinite loop
Keywords: 
Submitter:      Andrew Tolmach (apt@research.att.com)
Date:		6/30/92
Version:        0.83
System:         MIPS and SPARC
Severity:       
Problem:        Lexing an illegal token can lead to infinite loop.
Code:           Typing an arbitrary control character (such as CTRL/A),
		followed by return, sends system into an infinite loop.
Transcript:     - ^A
		std_in:0.0 Error: illegal token
		... (infinite loop) ...
Comments:	(1) Looping doesn't occur if illegal token is followed by a 
			complete legal phrase, e.g., ^A1;
		(2) Loop can be interrupted with CTRL/C.
		(3) Didn't occur in 0.82.
Fix: 
  Exception handler in ml.lex.sml uses Reject instead of Internal.Reject
  when Internal is not open, thus producing a handler for all exceptions.
  Change Reject to Internal.Reject in lexgen.
Status: fixed in 0.84
----------------------------------------------------------------------
Number: 580
Title: System.Compile, System.Env broken in 0.83
Keywords: 
Submitter:      Emden R. Gansner erg@ulysses.att.com
Date:           7/3/92
Version:        0.83
System:         Sparc 2, SunOS 4.1
Severity:       major
Problem:        Support for separate compilation is broken
Code:           
fun bug () = let
  open System.Compile System.Env
  val staticPerv = staticPart(!pervasiveEnvRef)
  val ins = open_string "signature T = sig end"
  val source = makeSource("<string>", 1, ins, false, std_out)
  val (static, _) = compile(source,staticPerv)
  in
    changeLvars static
  end
Transcript:
Standard ML of New Jersey, Version 0.83, June 12, 1992
val it = () : unit
- use "bug.sml";
val bug = fn : unit -> System.Compile.staticUnit
[closing bug.sml]
val it = () : unit
- bug();
Error: Compiler bug: CompileUnit 2
- 
Status: fixed in 0.86
----------------------------------------------------------------------
Number: 581
Title: line numbers in error and warning messages
Keywords: 
Submitter: Andrew Appel
Date: 7/3/92
Version: 0.83
Severity: serious
Problem: 
  Many of the error and warning messages have line numbers of 0.0.
Comments: Something wrong in the use of markabsyn.
Status: fixed in 0.88
----------------------------------------------------------------------
Number: 582
Title: interaction of open declarations and eval_stream
Keywords: 
Submitter:      Andrew Tolmach (apt@research.att.com)
Date:		7/7/92
Version:        0.83
System:         MIPS riscos
Severity:       minor
Problem:        If an open declaration is evaluated by 
		System.Compile.eval_stream, the resulting first-class
		environment is inconsistent: the static environment
		contains the elements of the opened structure, but the
		structure itself is not included in the dynamic environment.
		Subsequent attempts to look up these elements in the
		first-class environment trigger IntMapF exceptions.
Transcript:

Standard ML of New Jersey, Version 0.83, June 12, 1992
val it = () : unit
- open System.Compile System.Env System.Symbol;
open Compile Env Symbol
- structure Fred = struct val a = 10 end;
structure Fred : 
  sig
    val a : int
  end
- val e = eval_stream(open_string "open Fred", 
= layerEnv(!topLevelEnvRef,!pervasiveEnvRef));
open Fred
[closing <instream>]
val e = prim? : environment
- val e' = layerEnv(e,!pervasiveEnvRef); 
val e' = prim? : environment
- eval_stream(open_string "a",e');
[closing <instream>]

uncaught exception IntmapF
- 

Fix: (suggested by Tolmach)
	A top-level open should create a new structure entry in the 
	dynamic environment, and paths for entries in the static 
	environment should be adjusted to point at this new entry.
Fix: (implemented in 0.91)
  A top-level open causes all the runtime components of the structures
  opened to be rebound in the top-level environment.
Status: fixed in 0.91
----------------------------------------------------------------------
Number: 583
Title: catalogEnv raises Match exception
Keywords: 
Submitter:      Andrew Tolmach  (apt@research.att.com)
Date:		7/7/92
Version:        0.83
System:         Mips riscos
Severity:       minor
Problem:        Executing 
			System.Env.catalogEnv(staticPart (!pervasiveEnvRef))
		provokes a Match exception.

Comment:	Problem is evidently with 
		modules/moduleutil.sml:sortEnvBindings.binderGt,
		which contains an incomplete match.  Perhaps TAB binding
		entries need to be included?
Status: fixed in 0.85
----------------------------------------------------------------------
Number: 584
Title: infinite loop in cpsopt
Keywords: 
Submitter: John Reppy (jhr@research.att.com)
Date: 7/10/92
Version: 0.84
Severity: major
Problem: 
  The following program causes an infinite loop in cpsopt (I assume
  that this is another case of infinite loop unrolling):
Code: 
  fun foo () = let fun loop () = loop () in loop () end;
Status: fixed in 0.86
----------------------------------------------------------------------
Number: 585
Title: wrong type for notb in perv.sig
Keywords: 
Submitter: Nick Haines (Nick_Haines@VOILA.VENARI.CS.CMU.EDU)
Date: 7/10/92
Version: 0.84
Severity: minor
Problem: 
In boot/perv.sig, the type of `notb' is given as

		int * int -> int

not as

		int -> int

as it should be (and as boot/perv.sml has it).
Fix: change the type in perv.sig
Status: fixed in 0.86
----------------------------------------------------------------------
Number: 586
Title: uncaught Match in interpreter
Keywords: 
Submitter:      John Reppy (jhr@research.att.com)
Date:		7/10/92
Version:        0.77 and later
System:         any
Severity:       minor
Problem:        an uncaught exception Match in the interpreter
Code:
  System.Control.interp := true;
  datatype t = Z | S of t;
  fn (S _) => 0;
Transcript:
  Standard ML of New Jersey, Version 0.77, February 24, 1992
  Arrays have changed; see Release Notes
  val it = () : unit
  - datatype t = Z | S of t; System.Control.interp := true; fn (S _) => 0;
  datatype  t
  con S : t -> t
  con Z : t
  val it = () : unit
  std_in:2.57-2.69 Warning: match not exhaustive
          S _ => ...

  uncaught exception Match
  - 
Comments: Mark Lillibridge tracked this down to codegen/interp.sml;
  specifically, the function "f" in the case
    SWITCH(e,_, l as (DATAcon _, _)::_, d) => ...
  The problem seems to be a result of the changes in the datatype
  representation.

  Is this the same as bug #576?
  Bug # 591 is another instance of this
Status: fixed in 0.86
----------------------------------------------------------------------
Number: 587
Title: Compiler bug: ModuleUtil: Instantiate:getSigPos.2<Argument>
Keywords: 
Submitter: Olivier Nora
Date: 7/14/92
Version: 0.84
Severity: major
Problem: 
  Following code produces compiler bug:
  ModuleUtil: Instantiate:getSigPos.2<Argument>
Code:
signature SEQUENCE =
  sig
    exception LoopingError
    type 'a sequence
    val read        : '1a sequence  -> ('1a * '1a sequence) option
    val append : '1a list * '1a sequence -> '1a sequence
    val add_to : '1a sequence -> '1a sequence -> unit
    val app    : ('2a -> '2b) sequence -> '2a sequence 
                                            -> '2b sequence
    val value  : '1a -> '1a sequence
    val empty_sequence : unit -> '1a sequence
  end

signature SEMANTIC_VALUE = 
  sig
    type 'a semantic_type
    type semantic_value
    type 'a sequence
    exception SemanticValueError of string
    val add_semantic_value : semantic_value -> semantic_value -> unit
    val cast_from : 'a semantic_type -> semantic_value -> 'a sequence
    val cast_to : 'a semantic_type -> 'a sequence -> semantic_value
    val void_semantic_value : semantic_value
  end

funsig MK_SEMANTIC_VALUE (Sequence : SEQUENCE) = SEMANTIC_VALUE

functor MkWhole (functor MkSemanticValue : MK_SEMANTIC_VALUE) =
  struct
  end
Comment: [Cregut]
The bug can be obtained by the simple following code:

signature A=sig end
signature B=sig functor f():A end;

and comes from the fact that A is declared before so contains
no arguments. The fix is a 3 lines changed in extern.sml that
ask the function not to worry if the argument is not there.
It should be in .85

Status: fixed in 0.85
----------------------------------------------------------------------
Number: 588
Title: wrong printing of flex records with no fields
Keywords: 
Submitter:      Mark Lillibridge (mdl@cs.cmu.edu)
Date:		7/14/92
Version:        0.83
Severity:       minor
Problem:        The abstract syntax printing routines print out flex
		records with no fields wrong.  I.e., as "{,...}" instead
		of "{...}".

Code:           (fn {...} => ()) 3;

Transcript:

- (fn {...} => ()) 3;
std_in:18.1-18.18 Error: operator and operand don't agree (type mismatch)
  operator domain: {...}
  operand:         int
  in expression:
    ((fn {,...} => ())) 3
	  ^^^^-------------------- note error

Comments: same as bug #468 which was mislabeled
Status: fixed in 0.85
----------------------------------------------------------------------
Number: 589
Title: occurs check with nonstrict type abbreviations
Keywords: 
Submitter:      Mark Lillibridge (mdl@cs.cmu.edu)
Date:		7/14/92
Version:        0.83
Severity:       minor
Problem:        The occurs check is done wrong in the presense of
		non-strict type abbreviations.

Code:           type 'a CON = int;

		fun foo (x:'a) = (3:'a CON);

		fun bar x = bar (foo x);

Transcript:
		- type 'a CON = int;
		type 'a  CON = int
		- fun foo (x:'a) = (3:'a CON);
		val foo = fn : 'a -> 'a CON
		- fun bar x = bar (foo x);
		[type checker hangs at this point]

Status: fixed in 0.85
----------------------------------------------------------------------
Number: 590
Title: Some user type variable names are handled incorrectly.
Keywords: 
Submitter:      Mark Lillibridge (mdl@cs.cmu.edu)
Date:		7/14/92
Version:        0.83
Severity:       minor
Problem:        Some user type variable names are handled incorrectly.

Code:           val x : '_1abcd = 3;

Transcript:
- val x : '_1abcd = 3;
std_in:0.0-0.0 Error: pattern and expression in val dec don't agree (type mismatch)
  pattern:    '1_1abcU
  expression: int
  in declaration:
    x : '1_1abcU = 3
	   ^^^^------------------- note no 'd' on end!

Comment:
  Note that this kind of type variable name is no longer legal
  as of 0.85.
Status: fixed in 0.85
----------------------------------------------------------------------
Number: 591
Title: uncaught Match evaluating fn expressions.
Keywords: 
Submitter: Elsa Gunter
Date: 7/15/92
Version: 0.84
Severity: major
Problem: 
  Match exception raised when evaluating innocuous "fn" expressions.
  This was in a version of 0.84 in which eXene was loaded.
Transcript: 
  - fn (th :: _) => [th] | nil => nil;

  uncaught exception Match

  - fn (SOME x) => [x] 
  = | NONE => [];

  uncaught exception Match
Comment:  does not occur in plain 0.84
	  Confirmed to be an instance of bug #586
Status: fixed in 0.86
----------------------------------------------------------------------
Number: 592
Title: unhelpful error messages for record type mismatches
Keywords: 
Submitter:      thomas yan, tyan@cs.cornell.edu
Date:		7/17/92
Version:        <= .85
Severity:       minor, but annoying
Problem:        unhelpful error messages for record type mismatches
Code:           val {e:int, g:int, i:int, k:int option, m:int, p:int, ...} =
		    {e=0, g=0, j=0, k=[0], n=0, p=0, r=0, t=0, w=0, x=0, z=0}
		(* and similar variations *)
Transcript:     
    - val {e:int, g:int, i:int, k:int option, m:int, p:int, ...} =
	  {e=0, g=0, j=0, k=[0], n=0, p=0, r=0, t=0, w=0, x=0, z=0};
    std_in:0.0-331.117 Error: pattern and expression in val dec don't agree (record labels)
      pattern:    {e:int,g:int,i:int,k:int option,m:int,p:int,...}
      expression: {e:int,g:int,j:int,k:int list,n:int,p:int,r:int,t:int,w:int,x:int,z:int}
      in declaration:
        {e=e : int,g=g : int,i=i : int,k=k : int option,m=m : int,p=p : int,...} = {e=0,g=0,j=0,k=0 :: nil,n=0,p=0,r=0,t=0,w=0,x=0,z=0}

     - val {e:int, g:int, i:int, k:int option, m:int, p:int} = {e=0, g=0, j=0, k=[0], n=0, p=0};
     std_in:0.0-331.87 Error: pattern and expression in val dec don't agree (tycon mismatch)
       pattern:    {e:int,g:int,i:int,k:int option,m:int,p:int}
       expression: {e:int,g:int,j:int,k:int list,n:int,p:int}
       in declaration:
         {e=e : int,g=g : int,i=i : int,k=k : int option,m=m : int,p=p : int} = {e=0,g=0,j=0,k=0 :: nil,n=0,p=0}

Comments:	the error messages should indicate which labels are a) ok, b)
		extra/mispelled, c) missing.  also, (and this is a problem in
		general with type error messages), the field type mismatches
		should be highlighted, as just "tycon mismatch" gives one no
		idea where the mismatch is.

Fix:		use some kind of field by field comparison of the pattern and
		expression (a 2-column format, while verbose, might work well),
		perhaps first listing all fields that match, then listing all
		labels with mismatched types, then extra labels in the
		expression, then (possibly even for flex records) omitted
		labels.

Owner: 
Status: open
----------------------------------------------------------------------
Number: 593
Title: Compiler bug from bad overload declaration
Keywords: 
Submitter:      Mark Lillibridge (mdl@cs.cmu.edu)
Date:		7/17/92
Version:        0.83
System:         Sparc
Severity:       minor
Problem:        When values supplied in an overload declaration fail to
		meet the spec given, a compiler bug sometimes occurs.
Code:		
		fun baz [x] = x + 1;
		overload quux : ('a -> 'a) as tl and baz;

Transcript:
		- fun baz [x] = x + 1;
		std_in:0.0 Warning: match not exhaustive
		        x :: nil => ...
		val baz = fn : int list -> int
		- overload quux : ('a -> 'a) as tl and baz;
		Error: Compiler bug: matchScheme: bad tyvar 0
Status: fixed in 0.93c
----------------------------------------------------------------------
Number: 594
Title: "val _ = =;" now giving a different (wrong) error (same as 549)
Keywords: 
Submitter:      Mark Lillibridge (mdl@cs.cmu.edu)
Date:		7/17/92
Version:        0.83
System:         Sparc
Severity:       minor
Problem:        "val _ = =;" now giving a different (wrong) error

Code:		
		val _ = =;

Transcript:
		- val _ = =;
		std_in:7.9 Error: nonfix identifier required
		Error: Compiler bug: elabVB

Comment:
		This bug report is an addeneum to bug report #549.  That
bug reported that a non-handled Match exception occured on this program.
This bug report is to report that that no longer happens in 0.83.
Instead, a "elabVB" compiler bug occurs.  Still a bug though.

Status: same as 549
----------------------------------------------------------------------
Number: 595
Title: uncaught exception UnboundTable compiling bogus signature
Keywords: 
Submitter: 	John Reppy
Date: 		7/22/92
Version: 	0.85
System: 	Sun 4/75
Severity: 	minor
Problem:	uncaught exception UnboundTable in compiler
Code:
  signature JGRAPH =
    sig
      structure IO
    end

  functor JGraph (IO : IO) : JGRAPH =
    struct
    end

Transcript: 
  Standard ML of New Jersey, Version 0.85, July 17, 1992
  val it = () : unit
  - use "bug.sml";
  bug.sml:3.5-3.13 Error: syntax error: replacing STRUCTURE with EQTYPE
  bug.sml:1.1-8.5 Error: unmatched type spec: IO
  [closing bug.sml]

  uncaught exception UnboundTable
  - 
Comments:
  If you type the code into the top-level loop, you get a different
  kind of syntax error, and the bug doesn't occur.
Status: fixed in 0.89
----------------------------------------------------------------------
Number: 596
Title: bad line number info in error messages
Keywords: 
Submitter: Andrew Appel
Date: 7/24/92
Version: 0.86
Severity: major
Problem: 
  Many error messages say line "0.0-0.0".
Status: fixed in 0.88
----------------------------------------------------------------------
Number: 597
Title: Compiler bug: errors in cps/generic/extract
Keywords: 
Submitter: Magnus Carlsson <magnus@cs.chalmers.se>
Date: 7/26/92
Version: 0.75
System: Sun-4
Severity: major
Problem: 
  Following code causes Compiler bug: errors in cps/generic/extract.
Code: 
    datatype 'a fcont = Fcont of 'a fcont cont | Thrown of 'a;

    case callcc Fcont of
	Fcont k => throw k (Thrown 5)
      | Thrown i => i;
Transcript: 
    animal> smlc
    Standard ML of New Jersey, Version 75, November 11, 1991
    Arrays have changed; see Release Notes
    val it = () : unit
    - use "callcc-error.ml";
    [opening callcc-error.ml]
    datatype 'a  fcont
    con Fcont : 'a fcont cont -> 'a fcont
    con Thrown : 'a -> 'a fcont
    Error: Compiler bug: errors in cps/generic/extract
    [closing callcc-error.ml]
    -
Status: fixed in 0.89
----------------------------------------------------------------------
Number: 598
Title: Compiler bug: applyTyfun: not enough arguments
Keywords: 
Submitter: Andrew Appel
Date: 7/27/92
Version: 0.86
Severity: minor
Problem: 
    Compiler bug after incorrect datatype/withtype declaration.
Code:
    datatype 'a t = A of u
      withtype 'a u = 'a list
Transcript: 
    foo.sml:0.0 Error: type constructor u has the wrong number of arguments: 0
    Error: Compiler bug: applyTyfun: not enough arguments
Comment: [mdl]
	Turned out to be another bug in the module system where a bad
tycon was returned in spite of an error being detected.  Fix is to
change so that ERRORtyc is returned on error.  The diffs to fix it
follow.  I tested the change on the 86 sources and it seems to work
fine.
Fix:
diff moduleutil.sml.86 moduleutil.sml:
------------------ cut here ------------------
524c524
< fun checkArity(tycon, arity,err) =
---
> fun checkArity(tycon, arity,err,result) =
526c526
<     of ERRORtyc => ()
---
>     of ERRORtyc => result
529,531c529,532
<        then err COMPLAIN ("type constructor "^(Symbol.name(tycName(tycon)))^
< 		     " has the wrong number of arguments: "^makestring arity)
<        else ()
---
>        then (err COMPLAIN ("type constructor "^(Symbol.name(tycName(tycon)))^
> 		     " has the wrong number of arguments: "^makestring arity);
> 	    ERRORtyc)
>        else result
537,538c538,539
< 			(checkArity(spec,arity,err);
< 			 RELtyc{name=name,pos=(relpos,pos)})
---
> 			checkArity(spec,arity,err,
> 				 RELtyc{name=name,pos=(relpos,pos)})
540,541c541,542
< 			(checkArity(spec,arity,err);
< 			 RELtyc{name=name,pos=pos})
---
> 			checkArity(spec,arity,err,
> 				 RELtyc{name=name,pos=pos})
544c545
< 	      | (TYCbind tyc,_,_) => (checkArity(tyc,arity,err); tyc)
---
> 	      | (TYCbind tyc,_,_) => checkArity(tyc,arity,err,tyc)

Status: fixed in 0.88
----------------------------------------------------------------------
Number: 599
Title: symbolic path names are reversed in error messages.
Keywords: 
Submitter: Andrew Appel
Date: 7/27/92
Version: 0.86
Severity: minor
Problem: 
  Symbolic path names are reversed in error messages.
  What should be "MipsInstrSet.instruction", is instruction.MipsInstrSet (etc.)
Transcript: 
    mips/mips.sml:0.0 Error: Inconsistent arities in sharing type instruction.MipsIn
    strSet = instruction.C.<Parameter> : instruction.MipsInstrSet has arity 1 and in
    struction.C.<Parameter> has arity 0.
    mips/mips.sml:0.0 Error: Inconsistent arities in sharing type sdi.MipsInstrSet =
     sdi.C.<Parameter> : sdi.MipsInstrSet has arity 1 and sdi.C.<Parameter> has arit
Status: fixed in 0.89
----------------------------------------------------------------------
Number: 600
Title: Core dump running sourcegroup 2.1
Keywords: 
Submitter: Amy Felty
Date: 7/28/92
Version: 0.86
System: Sparc, SunOS 4.1
Severity: major
Problem: 
  Core dump running sourcegroup 2.1
Code: 
  SMLTool.targetNamer := SourceAction.sysBinary;
  System.Control.Print.signatures := 0;
  System.Control.indexing := true;

  structure SG = SourceGroup;
  structure SA = SourceAction;
  structure FL = FileList;

  fun smlFiles dirs =
      FL.extensionsOnly ["fun", "sig", "sml"] (FL.inDir (false, dirs));

  fun mlyaccFiles dirs =
      FL.extensionsOnly ["lex", "grm"] (FL.inDir (false, dirs));

  val mlyaccGroup = 
      SG.create [SG.Sources (FL.inFile ["mlyacc/base/base.files"])];
Transcript: 
  - lutece:working> sml-sg
  Standard ML of New Jersey, Version 0.86, July 22, 1992
    with SourceGroup 2.1 built on Fri Jul 24 10:48:49 EDT 1992
  val it = () : unit
  - use "build-elp.sml";
  val it = () : unit
  val it = () : unit
  val it = () : unit
  structure SG : SOURCEGROUP
  structure SA : SOURCEACTION
  structure FL : FILELIST
  val smlFiles = fn : string list -> string list
  val mlyaccFiles = fn : string list -> string list
  Segmentation fault
  lutece:working>
Status: fixed in 0.87
----------------------------------------------------------------------

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0