Number: 401 Title: Imperative types in SML/NJ 0.66 Keywords: types, weak types, polymorphism Submitter: Dave Berry 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 : functor GeneralArray : 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 => )) 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 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 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 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 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 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 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 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 ,nil),t2,flag) => ( 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 ,X2),t2,flag) => ( 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 => )) 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(("")) fun lookup_name (TENV(te)) i = let fun l [] _ _ = Id.intern(("")) | 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